home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_vw.lha / st80_vw / SmallDraw.VW < prev    next >
Text File  |  1993-07-24  |  94KB  |  2,423 lines
  1. "       NAME            SmallDraw.VW
  2.         AUTHOR          Dan Benson (modifications by David Arctur)
  3.     CONTRIBUTOR    Dan Benson <dbenson@scr.siemens.com>
  4.         FUNCTION    Simple Structured Graphics Editor
  5.         ST-VERSIONS     ST-80 VisualWorks
  6.         PREREQUISITES   
  7.         CONFLICTS       
  8.         DISTRIBUTION    world
  9.         VERSION         2.0
  10.         DATE        June 25, 1993
  11. SUMMARY
  12.  
  13. The SmallDraw application is an example of graphics rendering and MVC  
  14. application construction in Smalltalk-80. Originally written to run
  15. under Release 4.0, this version has been modified by David Arctur to
  16. run under VisualWorks (Thank you David!) See SmallDraw class comments
  17. for a description of the modifications.
  18.  
  19. This file contains the complete implementation of SmallDraw as described 
  20. in the third of a series of three tutorial articles entitled 'SmallDraw -  
  21. Release 4 Graphics and MVC, Part 3', published in the August 1992  
  22. issue of The Smalltalk Report, edited by John Pugh & Paul White, SIGS  
  23. Publications Group, Inc. For a more detailed description, please  
  24. refer to the cited article.
  25.  
  26. This source code is available to all with no restrictions. I only ask  
  27. that proper credit be passed on so that I might hear from those who  
  28. have found SmallDraw useful.
  29.  
  30. Dan Benson
  31. "!
  32.  
  33. ApplicationModel subclass: #SmallDraw
  34.     instanceVariableNames: 'objects insideColor borderColor lineWidth pages drawPane scalePane hAlignTo vAlignTo hAlign vAlign '
  35.     classVariableNames: 'Clipboard '
  36.     poolDictionaries: ''
  37.     category: 'SmallDraw'
  38.  
  39. "
  40.     The following instance variables are inherited by this class: 
  41.         ApplicationModel -- builder
  42.         Model -- dependents
  43.         Object -- 
  44. "!
  45. SmallDraw comment:
  46. 'SmallDraw is a very simple structured-graphics editor written by:
  47.  
  48. Dan Benson
  49. Siemens Corporate Research, Inc.
  50. 755 College Road East
  51. Princeton, NJ 08540
  52. dbenson@scr.siemens.com
  53.  
  54. This source code is available to all with no restrictions. I only ask that  
  55. proper credit be passed on so that I might hear from those who have found  
  56. SmallDraw useful.
  57.  
  58. This file contains the complete implementation of SmallDraw as described in the 
  59.  third of a series of tutorial articles entitled "SmallDraw - Release 4 Graphics 
  60.  and MVC, Part 3", published in the August 1992 issue of The Smalltalk Report,  
  61. edited by John Pugh & Paul White, SIGS Publications Group, Inc.
  62.  
  63. The SmallDraw application is an example of graphics rendering in Smalltalk-80  
  64. Release 4. The first article in the series contains an introduction to graphics 
  65. concepts and application construction with the MVC architecture through the  
  66. definition of a ''minimal'' SmallDraw. The second article adds the ability to  
  67. select and modify objects in the view. The third article extends the features  
  68. of SmallDraw to include grouping of objects, scrolling of the view,  
  69. cut/copy/pasting, alignment of objects through a DialogView, layering of  
  70. objects, and use of command keys. This filein corresponds to the implementation 
  71.  of the application described in the third and final article.
  72.  
  73. For a more detailed description, please refer to the above cited article.
  74.  
  75. MODIFICATIONS:
  76. This file was modified in June ''93 to work with VisualWorks 1.0 & Smalltalk-80 Release 4.1 by:
  77.  
  78. David Arctur
  79. Department of Urban & Regional Planning
  80. 431 ARCH, University of Florida
  81. Gainesville, FL  32611-2004
  82. arctur@nervm.nerdc.ufl.edu
  83.  
  84. The VisualWorks version may be executed from the Finder (Launcher button),
  85. or by evaluating  "SmallDraw open".  
  86.  
  87. VisualWorks follows a somewhat different approach in the MVC coupling than
  88. before.  The SmallDraw class (subclass of ApplicationModel) now holds onto
  89. instance variables for each of the subviews in the window (drawPane and 
  90. scalePane), and coordinates actions between them.  Different window layouts 
  91. on the model would be accomplished by making up additional "windowSpecs" 
  92. with the UI builder; these could add to, or ignore, subviews used by other
  93. windowSpecs.   
  94.  
  95. In updating SmallDraw, I found that a number of things which had worked in 
  96. Release 4, no longer worked under VisualWorks.  These included:
  97.     - deepCopy (I reimplemented this locally for the drawing clipboard)
  98.     - scrolling control (now handled transparently via the 
  99.             SmallDrawView>>preferredBounds method)
  100.     - alignment dialog (I rebuilt & simplified this using the UI builder)
  101.  
  102. In addition, numerous minor syntax changes were required.  While I was at it,
  103. I changed the names and groupings of the protocol categories somewhat
  104. (my apologies to Dan).
  105.  
  106. Please let me know if you have trouble with this, or make further changes to it.
  107.  
  108. -------------------------------------------------
  109. NOTICE: This file defines the following category and classes:
  110.  
  111. (''SmallDraw'' #SDEllipse #SDGraphicObject #SDGraphicGroup #SDLineSegment  
  112. #SDPolygon #SDPolyline #SDQuadrangle #SmallDraw #SmallDrawController  
  113. #SmallDrawView)
  114.  
  115. and adds a Point instance method:
  116.  
  117. quadrantContaining: aPoint
  118. -------------------------------------------------
  119.  
  120. SmallDraw Description:
  121.  
  122. This MVC application consists of a simple model called SmallDraw that opens  
  123. with a window containing a scalable graphics view, SmallDrawView. The user can  
  124. select from a menu one of several shapes to draw in the view using the mouse.  
  125. Drawing is controlled by the SmallDrawController which uses a rubber banding  
  126. technique for dynamic display. Figures drawn in the view are added to a list of 
  127. objects maintained by the model. All graphic objects have an inside color,  
  128. border color, and line width, and know how to display themselves in a view at a 
  129.  given scale.
  130.  
  131. Individual objects may be selected by either clicking on their interiors (if  
  132. solid) or edges. A range of objects may be selected by drawing a rubber-banding 
  133. rectangle around them. Once selected, the visual attributes of objects may be  
  134. changed or they may be translated or scaled.
  135.  
  136. To begin a SmallDraw application, select and do the following:
  137.  
  138.     SmallDraw open
  139.  
  140.  Also, see the other methods in the ''window creation'' category of SmallDraw.
  141.  
  142.  
  143. SmallDraw has the following instance variables:
  144.  
  145. objects            <OrderedCollection>    the list of objects in the drawing (Associations)
  146. insideColor    <ColorValue>        the default inside color for new objects
  147. borderColor    <ColorValue>        the default border color for new objects
  148. lineWidth        <Integer>            the default line width for new objects
  149. pages            <Point>            indicates the number of pages in horizontal and 
  150.                                      vertical directions
  151. drawPane        <ValueHolder on: SmallDrawView>    holds onto an instance of SmallDrawView
  152. scalePane        <ValueHolder on: ComposedTextView>    used to display the current scale value
  153.     The next four instance variables are set during the alignment dialog:
  154. vAlign            <ValueHolder on: Boolean>    vertical alignment {true|false}
  155. vAlignTo        <ValueHolder on: Symbol>    vertical alignment {#top|#center|#bottom}
  156. hAlign            <ValueHolder on: Boolean>    horizontal alignment {true|false}
  157. hAlignTo        <ValueHolder on: Symbol>    horizontal alignment {#left|#center|#right}
  158.  
  159. SmallDraw has the following class variables:
  160.  
  161. Clipboard        <Object>            intermediate storage of objects for  
  162.                                     cut/copy/paste/duplicate
  163.  
  164.  
  165. The objects instance variable actually stores a collection of Associations in  
  166. which the value is the graphic object and the value is a Boolean that indicates 
  167. whether or not the object is currently selected.
  168.  
  169. As objects are added to the drawing they are layered on top of each other.  
  170. Their postions within this stack may be changed through a menu selection.
  171.  
  172. Most menu operations apply only to the current selection of objects. For  
  173. instance, the selected objects can be aligned, grouped, ungrouped, copied, and  
  174. cut, or their visual aspects can be modified.
  175.  
  176. A SmallDraw document consists of one or more pages. Objects are not allowed to  
  177. be translated or scaled beyond the topmost or left most pages of the document.  
  178. If this happens, a warning bell is rung and the operation is not permitted to  
  179. continue. If objects are moved beyond the rightmost or bottommost pages, the  
  180. total size of the document is automatically grown to fit the object''s new  
  181. postions. The document may be resized to its minimum configuration (to include  
  182. all existing objects) through a menu selection.
  183.  
  184. Objects are cut/copied/pasted via the common class variable Clipboard. In this  
  185. way, all SmallDraw applications have access to the same Clipboard.
  186. '!
  187.  
  188.  
  189. !SmallDraw methodsFor: 'window creation'!
  190.  
  191. initialize
  192.     super initialize.
  193.     objects := OrderedCollection new.
  194.     insideColor := nil.
  195.     borderColor := ColorValue black.
  196.     lineWidth := 1.
  197.     pages := self minimumPages.
  198.     drawPane := SmallDrawView new
  199.                     model: self ;
  200.                     controller: SmallDrawController new .
  201.     self scalePane: 100.!
  202.  
  203. openIt
  204.         "SmallDraw new openIt"
  205.         ScheduledWindow new
  206.                 label: 'SmallDraw';
  207.                 component: (WidgetWrapper on: 
  208.                        ( (SmallDrawView model: self) controller: SmallDrawController new)); 
  209.                 openWithExtent: 200@200!
  210.  
  211. openWithTwoViews
  212.         "SmallDraw new openWithTwoViews"
  213.         | window composite|
  214.         window := ScheduledWindow new label: 'SmallDraw'.
  215.         composite := CompositePart new. 
  216.         window component: composite. 
  217.         composite 
  218. "The left hand view."
  219.                 add: (WidgetWrapper on:
  220.                                 ((SmallDrawView model: self) controller: SmallDrawController new)) 
  221.                 in: (LayoutFrame new 
  222.                         leftFraction: 0; 
  223.                         rightFraction: 0.5; 
  224.                         topFraction: 0; 
  225.                         bottomFraction: 1);
  226. "The right hand view."
  227.                 add: (WidgetWrapper on:
  228.                                 ((SmallDrawView model: self) controller: SmallDrawController new)) 
  229.                 in: (LayoutFrame new 
  230.                         leftFraction: 0.5; 
  231.                         rightFraction: 1; 
  232.                         topFraction: 0; 
  233.                         bottomFraction: 1). 
  234.         window openWithExtent: 200@200! !
  235.  
  236. !SmallDraw methodsFor: 'aspects'!
  237.  
  238. drawPane
  239.  
  240.     ^drawPane!
  241.  
  242. scalePane
  243.     "This method was generated by UIDefiner. The initialization provided 
  244.     below may have been preempted by an initialize method."
  245.  
  246.     ^scalePane isNil ifTrue: [scalePane := String new asValue] ifFalse: [scalePane]!
  247.  
  248. scalePane: aNumber
  249.     "display the current view's scale value"
  250.     aNumber rounded = aNumber
  251.         ifTrue: [self scalePane value: aNumber printString, '%']
  252.         ifFalse: [self scalePane value: aNumber asFloat printString, '%']! !
  253.  
  254. !SmallDraw methodsFor: 'menu'!
  255.  
  256. processCommandKey: aKey
  257.         "Respond to aKey which may corrsepond to one of the receiver's menu  
  258. commands. If not, ignore it."
  259.         aKey = Character backspace ifTrue: [self delete].
  260.         aKey = $x ifTrue: [self cut].
  261.         aKey = $c ifTrue: [self copy].
  262.         aKey = $v ifTrue: [self paste].
  263.         aKey = $f ifTrue: [self moveForward].
  264.         aKey = $j ifTrue: [self moveBackward].
  265.         aKey = $d ifTrue: [self duplicate].
  266.         aKey = $a ifTrue: [self selectAll].
  267.         aKey = $k ifTrue: [self doAlignment].
  268.         aKey = $g ifTrue: [self group].
  269.         aKey = $G ifTrue: [self unGroup].!
  270.  
  271. yellowButtonMenu
  272.  
  273.     ^self drawPane controller initializeMenu! !
  274.  
  275. !SmallDraw methodsFor: 'clipboard'!
  276.  
  277. clipboardDisplayBox
  278.         ^Clipboard inject: Clipboard first displayBox into: [:bb :o | bb merge: o displayBox]!
  279.  
  280. clipboardFull
  281.         ^Clipboard notNil and: [Clipboard isEmpty not]!
  282.  
  283. copy
  284.         self hasSelection
  285.                 ifTrue: [Clipboard := self selectedObjects 
  286.                 collect: [ :each | each deepCopy] ]!
  287.  
  288. cut
  289.         self hasSelection ifTrue: [
  290.                 Clipboard := self selectedObjects.
  291.                 self objects: (self objects reject: [:p | p value]).
  292.                 self changed: #rectangle with: self clipboardDisplayBox]!
  293.  
  294. delete
  295.         self hasSelection ifTrue: [| cleanUp |
  296.                 cleanUp := self selectedObjectsDisplayBox.
  297.                 self objects: (self objects reject: [:p | p value]).
  298.                 self changed: #rectangle with: cleanUp]!
  299.  
  300. duplicate
  301.         "Add a copy of the current selection without changing the Clipboard."
  302.         self hasSelection ifTrue: [ | newObjects |
  303.                 newObjects := ((self selectedObjectAssociations 
  304.                 collect: [ :a | a copy key: a key deepCopy ]) do: [:oa |
  305.                         oa key translateBy: self pasteOffset]).
  306.                 self deselectAll.
  307.                 self objects addAllFirst: newObjects.
  308.                 self pages: (self pages max: self minimumObjectPages).
  309.                 self changed: #rectangle with: self selectedObjectsDisplayBox]!
  310.  
  311. paste
  312.         self clipboardFull ifTrue: [
  313.                 self deselectAll.
  314.                 self objects addAllFirst: ((Clipboard do: [:o |
  315.                         o translateBy: self pasteOffset]) copy collect: [:o | o -> true]).
  316.                 self pages: (self pages max: self minimumObjectPages).
  317.                 self changed: #rectangle with: self clipboardDisplayBox]!
  318.  
  319. pasteOffset
  320.         "Answer the default offset for pasting objects from their copied positions."
  321.         ^10@10! !
  322.  
  323. !SmallDraw methodsFor: 'drawing'!
  324.  
  325. addFirst: anObject
  326.         "Add a new drawing object and select it."
  327.     | oldPages |
  328.     oldPages := self pages.
  329.     self deselectAll.
  330.     self objects addFirst: (anObject -> true).
  331.     self changed: #add with: (Array with: anObject) .
  332.     self pages: (self pages max: self minimumObjectPages)!
  333.  
  334. addObject: anObject
  335.         "Initialize the colors and line width of anObject and add it to the  
  336. display list."
  337.         anObject
  338.                 insideColor: self insideColor;
  339.                 borderColor: self borderColor;
  340.                 lineWidth: self lineWidth.
  341.         self addFirst: anObject! !
  342.  
  343. !SmallDraw methodsFor: 'object attributes'!
  344.  
  345. borderColor
  346.         ^borderColor!
  347.  
  348. changeBorderColor
  349.         | newColor names |
  350.         names := ColorValue constantNames asSortedCollection  
  351. asOrderedCollection addFirst: #NONE; yourself; asArray.
  352.         newColor := (PopUpMenu labelList: (Array with: names)) startUpWithHeading: 'Choose BORDER Color: '.
  353.         (newColor notNil and: [newColor > 0])
  354.                 ifTrue: [newColor := newColor = 1
  355.                                         ifTrue: [nil]
  356.                                         ifFalse: [ColorValue perform: (names at: newColor)].
  357.                                 self hasSelection
  358.                                         ifFalse: [borderColor := newColor]
  359.                                         ifTrue: [self selectedObjects do: [:o | o borderColor: newColor].
  360.                                                         self changed: #rectangle with: self selectedObjectsDisplayBox]]!
  361.  
  362. changeInsideColor
  363.         | newColor names |
  364.         names := ColorValue constantNames asSortedCollection  
  365.             asOrderedCollection addFirst: #NONE; yourself; asArray.
  366.         newColor := (PopUpMenu labelList: (Array with: names)) 
  367.             startUpWithHeading: 'Choose INSIDE Color: '.
  368.         (newColor notNil and: [newColor > 0])
  369.                     ifTrue: [newColor := newColor = 1
  370.                                         ifTrue: [nil]
  371.                                         ifFalse: [ColorValue perform: (names at: newColor)].
  372.                                 self hasSelection
  373.                                         ifFalse: [insideColor := newColor]
  374.                                         ifTrue: [self selectedObjects do: [:o | o insideColor: newColor].
  375.                                                         self changed: #rectangle with: self selectedObjectsDisplayBox]]!
  376.  
  377. changeLineWidth
  378.         | answer |
  379.         answer := DialogView
  380.                 request: 'New line width (in pixels)?'
  381.                 initialAnswer: self lineWidth printString.
  382.         (answer isNil or: [answer isEmpty])
  383.                 ifFalse: [answer := answer asNumber abs rounded max: 1.
  384.                                 self hasSelection
  385.                                         ifFalse: [lineWidth := answer]
  386.                                         ifTrue: [| bb |
  387.                                                         bb := self selectedObjectsDisplayBox.
  388.                                                         self selectedObjects do: [:o | o lineWidth: answer].
  389.                                                         self changed: #rectangle
  390.                                     with: (bb merge: self selectedObjectsDisplayBox)]]!
  391.  
  392. insideColor
  393.         ^insideColor!
  394.  
  395. lineWidth
  396.         ^lineWidth! !
  397.  
  398. !SmallDraw methodsFor: 'object access'!
  399.  
  400. allObjects
  401.         ^self objects collect: [:a | a key]!
  402.  
  403. allObjectsBoundingBox
  404.         "Answer the bounding that contains all selectedObjects."
  405.         ^self allObjects
  406.                 inject: (0@0 extent: 0@0)
  407.                 into: [:bb :o | bb merge: o boundingBox]!
  408.  
  409. allObjectsDisplayBox
  410.         "Answer the bounding that contains all selectedObjects."
  411.         ^self allObjects
  412.                 inject: (0@0 extent: 0@0)
  413.                 into: [:bb :o | bb merge: o displayBox]!
  414.  
  415. displayObjects
  416.         "Answer the receiver's objects in order for display purposes."
  417.         ^self objects reverse collect: [:a | a key]!
  418.  
  419. objects
  420.         ^objects!
  421.  
  422. objects: anOrderedCollectionOfAssociations
  423.         objects := anOrderedCollectionOfAssociations!
  424.  
  425. selectedObjectAssociations
  426.         "Answer all currently selected Associations."
  427.         ^self objects select: [:p | p value]!
  428.  
  429. selectedObjects
  430.         "Answer all currently selected objects."
  431.         ^self selectedObjectAssociations collect: [:a | a key]!
  432.  
  433. selectedObjectsBoundingBox
  434.         "Answer the bounding that contains all selectedObjects."
  435.         ^self hasSelection
  436.                 ifFalse: [nil]
  437.                 ifTrue: [| allObjects |
  438.                                 (allObjects := self selectedObjects)
  439.                                         inject: allObjects first boundingBox
  440.                                         into: [:bb :o | bb merge: o boundingBox]]!
  441.  
  442. selectedObjectsDisplayBox
  443.         "Answer the display box that contains all currently selected objects."
  444.         | allObjects |
  445.         ^(allObjects := self selectedObjects) 
  446.                 inject: allObjects first displayBox
  447.                 into: [:bb :o | bb merge: o displayBox]! !
  448.  
  449. !SmallDraw methodsFor: 'selecting'!
  450.  
  451. deselectAll
  452.         | currentSelection |
  453.         currentSelection := self selectedObjects.
  454.         self objects do: [:p | p value: false].
  455.         self changed: #selection with: currentSelection!
  456.  
  457. hasSelection
  458.         "Answer true if there is at least one object selected."
  459.  
  460.             ^(self objects detect: [:p | p value] ifNone: [nil]) notNil!
  461.  
  462. selectAll
  463.         self deselectAll.
  464.         self objects do: [:p | p value: true].
  465.         self changed: #selection with: self selectedObjects!
  466.  
  467. selectObject: anObjectOrNil extend: aBoolean
  468.         self selectRange: (Array with: anObjectOrNil) extend: aBoolean!
  469.  
  470. selectRange: aCollectionOfObjects extend: aBoolean
  471.         "Toggle the selection status of the objects in aCollectionOfObjects. If 
  472.      aBoolean is true then extend the selection."
  473.  
  474.         aBoolean ifFalse: [self deselectAll].
  475.         aCollectionOfObjects do: [:obj | | oa |
  476.                 (oa := self objects detect: [:o | o key == obj] ifNone: [nil]) notNil
  477.                         ifTrue: [oa value: oa value not]].
  478.         self changed: #selection with: aCollectionOfObjects! !
  479.  
  480. !SmallDraw methodsFor: 'translate/scale'!
  481.  
  482. scaleBy: aPercentagePoint aboutHandleAt: anIndex absolute: aBoolean
  483.         "Scale all currently selected objects by aPercentagePoint from each  
  484.     respective handle at anIndex, notify dependents of clean up region."
  485.  
  486.         | cleanUp |
  487.         cleanUp := self selectedObjectsDisplayBox.
  488.         self selectedObjects do: [:o | o scaleBy: aPercentagePoint aboutHandleAt: anIndex absolute: aBoolean].
  489.         self pages: (self pages max: self minimumObjectPages).
  490.         self changed: #rectangle with: (cleanUp merge: self selectedObjectsDisplayBox)!
  491.  
  492. translateBy: aPoint
  493.         "Translate the selected objects by aPoint, notify dependents of clean up region."
  494.         | cleanUp |
  495.         cleanUp := self selectedObjectsDisplayBox.
  496.         self selectedObjects do: [:o | o translateBy: aPoint].
  497.         self pages: (self pages max: self minimumObjectPages).
  498.         self changed: #rectangle with: (cleanUp merge: (cleanUp translatedBy: aPoint)).! !
  499.  
  500. !SmallDraw methodsFor: 'grouping'!
  501.  
  502. group
  503.         "Group together the currently selected set of objects. Notify  
  504.     dependents of the damaged rectangle because it may result in bringing objects  
  505.     forward in the drawing."
  506.         self hasSelection ifTrue: [ |selection|
  507.                 (selection := self selectedObjectAssociations) size > 1
  508.                         ifTrue: [self objects
  509.                         add: ((SDGraphicGroup with: self selectedObjects reverse) -> true)
  510.                         before: selection first.
  511.                                         selection do: [:o | self objects remove: o].
  512.                                         self changed: #rectangle with: self selectedObjectsDisplayBox]]!
  513.  
  514. unGroup
  515.         "Break apart any currently selected GraphicGroups. Notify dependents of 
  516.      a change in the current selection (does not require redrawing in rectangle)."
  517.         self hasSelection ifTrue: [ |selection|
  518.                 selection := self selectedObjectAssociations.
  519.                 self deselectAll.
  520. "Break apart grouped object while ignoring non-groups."
  521.                 selection do: [:g | (g key isKindOf: SDGraphicGroup)
  522.                                                 ifTrue: [g key elements do: [:each | self objects add: (each -> true) after: g].
  523.                                         self objects remove: g]].
  524.                 self changed: #selection with: self selectedObjects]! !
  525.  
  526. !SmallDraw methodsFor: 'bring/send'!
  527.  
  528. moveBackward
  529.         self hasSelection ifTrue: [
  530.                 self selectedObjectAssociations reverseDo: [:oa | | after |
  531.                         self objects last == oa
  532.                                 ifFalse: [after := self objects after: oa.
  533.                                                 self objects remove: oa.
  534.                                                 self objects add: oa after: after]].
  535.                 self changed: #rectangle with: self selectedObjectsDisplayBox]!
  536.  
  537. moveForward
  538.         self hasSelection ifTrue: [
  539.                 self selectedObjectAssociations do: [:oa | | before |
  540.                         self objects first == oa
  541.                                 ifFalse: [before := self objects before: oa.
  542.                                                 self objects remove: oa.
  543.                                                 self objects add: oa before: before]].
  544.                 self changed: #rectangle with: self selectedObjectsDisplayBox]!
  545.  
  546. moveToBack
  547.         self hasSelection ifTrue: [ | selection |
  548.                 selection := self selectedObjectAssociations.
  549.                 selection do: [:oa | self objects remove: oa].
  550.                 self objects addAllLast: selection.
  551.                 self changed: #rectangle with: self selectedObjectsDisplayBox]!
  552.  
  553. moveToFront
  554.         self hasSelection ifTrue: [ | selection |
  555.                 selection := self selectedObjectAssociations.
  556.                 selection do: [:oa | self objects remove: oa].
  557.                 self objects addAllFirst: selection.
  558.                 self changed: #rectangle with: self selectedObjectsDisplayBox]! !
  559.  
  560. !SmallDraw methodsFor: 'alignment'!
  561.  
  562. alignDialog
  563.  
  564.     | dialog |
  565.  
  566.     "create the dialog and its builder"
  567.     builder := (dialog := SimpleDialog new) builder.
  568.     builder aspectAt: #vAlign put: self vAlign.
  569.     builder aspectAt: #vAlignTo put: self vAlignTo.
  570.     builder aspectAt: #hAlign put: self hAlign.
  571.     builder aspectAt: #hAlignTo put: self hAlignTo.
  572.     
  573.     "load the interface from the desired spec, then open it"
  574.     dialog allButOpenFrom: (self class interfaceSpecFor: #alignmentSpec).
  575.     builder openDialog.
  576.  
  577.     (builder aspectAt: #accept) value
  578.         ifTrue: [
  579.             self vAlign value: (builder aspectAt: #vAlign) value.
  580.             self vAlignTo value: (builder aspectAt: #vAlignTo) value.
  581.             self hAlign value: (builder aspectAt: #hAlign) value.
  582.             self hAlignTo value: (builder aspectAt: #hAlignTo) value.
  583.             self doAlignment ]!
  584.  
  585. doAlignment
  586.  
  587.       self hasSelection ifTrue: [| bb repair |
  588.                 bb := self selectedObjectsBoundingBox.
  589.                 repair := self selectedObjectsDisplayBox.
  590.  
  591.     "Vertical movement."
  592.         self vAlign value ifTrue: [
  593.                 self vAlignTo value  == #top ifTrue:[
  594.                         self selectedObjects do: [:o | o translateBy: 0@(bb origin y - o boundingBox origin y)]].
  595.                 self vAlignTo value == #center ifTrue:[
  596.                         self selectedObjects do: [:o | o translateBy: 0@(bb center y - o boundingBox center y)]].
  597.                 self vAlignTo value == #bottom ifTrue:[
  598.                         self selectedObjects do: [:o | o translateBy: 0@(bb corner y - o boundingBox corner y)]]].
  599.     "Horizontal movement."
  600.         self hAlign value ifTrue: [
  601.                 self hAlignTo value == #left ifTrue:[
  602.                         self selectedObjects do: [:o | o translateBy: (bb origin x - o boundingBox origin x) @0]].
  603.                 self hAlignTo value == #center ifTrue:[
  604.                         self selectedObjects do: [:o | o translateBy: (bb center x - o boundingBox center x) @0]].
  605.                 self hAlignTo value == #right ifTrue:[
  606.                         self selectedObjects do: [:o | o translateBy: (bb corner x - o boundingBox corner x) @0]]].
  607.  
  608.            self changed: #rectangle with: repair]!
  609.  
  610. hAlign
  611.     "This method was generated by UIDefiner. The initialization provided 
  612.     below may have been preempted by an initialize method."
  613.  
  614.     ^hAlign isNil ifTrue: [hAlign := false asValue] ifFalse: [hAlign]!
  615.  
  616. hAlignTo
  617.     "This method was generated by UIDefiner. The initialization provided 
  618.     below may have been preempted by an initialize method."
  619.  
  620.     ^hAlignTo isNil ifTrue: [hAlignTo := nil asValue] ifFalse: [hAlignTo]!
  621.  
  622. vAlign
  623.     "This method was generated by UIDefiner. The initialization provided 
  624.     below may have been preempted by an initialize method."
  625.  
  626.     ^vAlign isNil ifTrue: [vAlign := false asValue] ifFalse: [vAlign]!
  627.  
  628. vAlignTo
  629.     "This method was generated by UIDefiner. The initialization provided 
  630.     below may have been preempted by an initialize method."
  631.  
  632.     ^vAlignTo isNil ifTrue: [vAlignTo := nil asValue] ifFalse: [vAlignTo]! !
  633.  
  634. !SmallDraw methodsFor: 'pages'!
  635.  
  636. bounds
  637.         ^0@0 extent: self documentSize!
  638.  
  639. documentSize
  640.         "Answer the size of the document in terms of the number of 8.5 x 11  
  641. inch pages."
  642.         ^self pages * self pageSizeInPixels!
  643.  
  644. minimumObjectPages
  645.         "Answer the minimum number of pages (as a Point) to hold the current collection of objects."
  646.         | minObjectPages minAcross minDown |
  647.         minObjectPages := self allObjectsDisplayBox extent.
  648.         minAcross := (minObjectPages x // self pageSizeInPixels x) +
  649.                 ((minObjectPages x \\ self pageSizeInPixels x) > 0
  650.                         ifTrue: [1] ifFalse: [0]).
  651.         minDown := (minObjectPages y // self pageSizeInPixels y) +
  652.                 ((minObjectPages y \\ self pageSizeInPixels y) > 0
  653.                         ifTrue: [1] ifFalse: [0]).
  654.         ^self minimumPages max: (minAcross @ minDown)!
  655.  
  656. minimumPages
  657.         "The minimum size for a document is one page."
  658.         ^1@1!
  659.  
  660. pages
  661.         "Answer the number of pages arranged horizontally and vertically (as a Point)."
  662.         ^pages!
  663.  
  664. pages: aPoint
  665.         "Set the size of the document in terms of the number of pages across  
  666.     and down. The minimum allowed is the minimum size that contains all objects."
  667.         | newPages |
  668.         newPages := aPoint max: self minimumObjectPages.
  669.         pages = newPages
  670.          ifFalse: [
  671.             pages := newPages.
  672.             self drawPane changedPreferredBounds: nil.
  673.                   self changed: #pages]!
  674.  
  675. pagesAcross
  676.         "Answer the number of pages arranged horizontally."
  677.         ^self pages x!
  678.  
  679. pagesDown
  680.         "Answer the number of pages arranged vertically."
  681.         ^self pages y!
  682.  
  683. pageSizeInPixels
  684.         "Answer the size of one 8.5 x 11 inch page (with 1/2 inch margins),  
  685.     scaled by the number of pixels per inch (72). This number is calculated as:  
  686.     ((7.5@10) * 72) rounded."
  687.         ^540@720!
  688.  
  689. preferredBounds
  690.         ^self bounds!
  691.  
  692. setSmallestPages
  693.         self pages: self minimumObjectPages! !
  694. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  695.  
  696. SmallDraw class
  697.     instanceVariableNames: ''
  698.  
  699. "
  700.     The following instance variables are inherited by this class: 
  701.         ApplicationModel class -
  702.         Model class -
  703.         Object class -
  704.         Class -- name, classPool, sharedPools
  705.         ClassDescription -- instanceVariables, organization
  706.         Behavior -- superclass, methodDict, format, subclasses
  707.         Object -- 
  708. "!
  709.  
  710.  
  711. !SmallDraw class methodsFor: 'instance creation'!
  712.  
  713. new
  714.         "SmallDraw open"
  715.         ^super new initialize! !
  716.  
  717. !SmallDraw class methodsFor: 'interface specs'!
  718.  
  719. alignmentSpec
  720.     "UIPainter new openOnClass: self andSelector: #alignmentSpec"
  721.  
  722.     ^#(#FullSpec #window: #(#WindowSpec #label: 'Align Selected Objects' #min: #(#Point 50 50 ) #bounds: #(#Rectangle 897 349 1191 608 ) ) #component: #(#SpecCollection #collection: #(#(#RadioButtonSpec #layout: #(#Point 40 64 ) #model: #vAlignTo #label: 'Top' #select: #top ) #(#RadioButtonSpec #layout: #(#Point 40 112 ) #model: #vAlignTo #label: 'Center' #select: #center ) #(#RadioButtonSpec #layout: #(#Point 40 160 ) #model: #vAlignTo #label: 'Bottom' #select: #bottom ) #(#RadioButtonSpec #layout: #(#Point 176 64 ) #model: #hAlignTo #label: 'Left' #select: #left ) #(#RadioButtonSpec #layout: #(#Point 176 112 ) #model: #hAlignTo #label: 'Center' #select: #center ) #(#RadioButtonSpec #layout: #(#Point 176 160 ) #model: #hAlignTo #label: 'Right' #select: #right ) #(#GroupBoxSpec #layout: #(#Rectangle 32 56 128 192 ) ) #(#GroupBoxSpec #layout: #(#Rectangle 168 56 264 192 ) ) #(#ActionButtonSpec #layout: #(#Rectangle 48 216 120 240 ) #model: #accept #label: 'Okay' #defaultable: tr!
  723. ue ) #(#ActionButtonSpec #layout: 
  724. #(#Rectangle 176 216 248 240 ) #model: #cancel #label: 'Cancel' #defaultable: true ) #(#CheckBoxSpec #layout: #(#Point 32 24 ) #name: #vAlign #model: #vAlign #label: 'Vertical' ) #(#CheckBoxSpec #layout: #(#Point 168 24 ) #name: #hAlign #model: #hAlign #label: 'Horizontal' ) ) ) )!
  725.  
  726. windowSpec
  727.     "UIPainter new openOnClass: self andSelector: #windowSpec"
  728.  
  729.     ^#(#FullSpec #window: #(#WindowSpec #label: 'SmallDraw' #min: #(#Point 50 50 ) #bounds: #(#Rectangle 805 415 1268 840 ) #flags: 4 #menu: #yellowButtonMenu ) #component: #(#SpecCollection #collection: #(#(#ArbitraryComponentSpec #layout: #(#LayoutFrame 0 0 27 0 0 1 0 1 ) #flags: 11 #component: #drawPane ) #(#LabelSpec #layout: #(#LayoutOrigin -125 1 2 0 ) #label: 'Scale: ' ) #(#InputFieldSpec #layout: #(#LayoutFrame -76 1 1 0 -1 1 25 0 ) #model: #scalePane #tabable: false #isReadOnly: true #type: #string ) ) ) )! !
  730.  
  731. View subclass: #SmallDrawView
  732.     instanceVariableNames: 'scale useGrid showPageBreaks '
  733.     classVariableNames: 'DrawHandle '
  734.     poolDictionaries: ''
  735.     category: 'SmallDraw'
  736.  
  737. "
  738.     The following instance variables are inherited by this class: 
  739.         View -- controller
  740.         DependentPart -- model
  741.         VisualPart -- container
  742.         VisualComponent -
  743.         Object -- 
  744. "!
  745. SmallDrawView comment:
  746. 'I represent a scalable graphics view that asks its model''s displayObjects to  
  747. display themselves on my graphicsContext at a given scale, which I keep track  
  748. of. I allow my scale to be changed through a menu selection. One of several  
  749. scales may be selected, from minScale (12.5%) to maxScale (3200%). I am  
  750. designed to be used with the model SmallDraw and controller  
  751. SmallDrawController.
  752.  
  753. I keep track of my current scale as a percent. When I ask objects to display  
  754. themselves, I convert this value into a scaling factor Point.
  755.  
  756. I refresh myself in several ways whenever I get an update: message. The  
  757. following aspects are monitored:
  758.  
  759. Aspect: #add - indicates that a new display object was added to the list
  760. Action: redisplay objects and toggle the handles for the newly added object
  761.  
  762. Aspect: #selection - indicates that the selection has been changed
  763. Action: toggle handles for the selected objects
  764.  
  765. Aspect: #rectangle - indicates that a rectangle needs repairing
  766. Action: redraw only the rectangle
  767.  
  768. Aspect: #pages - indicates that the document has changed size
  769. Action: update my scrolling controls and redraw the entire view
  770.  
  771. Aspect: #zoomIn or #zoomOut - generated by the model via the menu bar
  772. Action: change the scale (multiply or divide) by one step (factor of 2)
  773.  
  774. When objects are selected I ask them for their display handle points and then I 
  775. display a black rectangle at each of the points. I use a BITBLT technique so  
  776. that the handles can be drawn and erased quickly without having to refresh the  
  777. drawing.
  778.  
  779. I can be scrolled both vertically and horizontally. I use a grid of either the  
  780. minimum (1@1) or whatever my model''s pasteOffset is set to. This can be  
  781. changed through a menu selection. I also am able to display page breaks,  
  782. depending on the size of document of my model. Page breaks show up as light  
  783. gray rectangles and may be turned on or off through a menu selection. I obtain  
  784. the size of the pages and the page configuration from my model.
  785.  
  786. I have the following instance variables:
  787.  
  788. scale                <Number>        current scale to be used for  
  789.                                     display (as percent)
  790. useGrid            <Boolean>       indicates whether to use a fine/coarse grid  
  791. showPageBreaks  <Boolean>       indicates whether page breaks should be  
  792.                                     displayed
  793.  
  794. I have one class variable:
  795.  
  796. DrawHandle      <Rectangle>     display handle for graphic object manipulation'!
  797.  
  798.  
  799. !SmallDrawView methodsFor: 'displaying'!
  800.  
  801. displayObjects: aCollectionOfObjects on: aGC
  802.         | bb|
  803.         aGC translateBy: self offset.
  804.         bb := aGC clippingBounds scaledBy: self displayScale reciprocal.
  805.         aCollectionOfObjects do: [:o | 
  806.                 (o  displayBox intersects: bb)
  807.                         ifTrue: [o  displayOn: aGC scale: self displayScale]].
  808.         aGC translateBy: self offset negated!
  809.  
  810. displayOn: aGC
  811.         self
  812.                 displayPageBreaksOn: aGC;
  813.                 displayObjects: self model displayObjects on: aGC;
  814.                 toggleHandlesFor: self model selectedObjects on: aGC.!
  815.  
  816. displayPageBreaksOn: aGC
  817.         self showPageBreaks
  818.                 ifTrue: [ | page |
  819.         aGC translateBy: self offset.
  820.         page := (self model pageSizeInPixels * self displayScale) rounded.
  821.         aGC paint: self pageBreakColor.
  822.         0 to: self model pagesAcross - 1 do: [:x |
  823.                 0 to: self model pagesDown - 1 do: [:y |
  824.                         aGC
  825.                                 displayRectangularBorder: (0@0 extent: page)
  826.                                 at: (page * (x@y))]]    .
  827.         aGC translateBy: self offset negated]!
  828.  
  829. handle
  830.         ^DrawHandle scaledBy: self displayScale reciprocal!
  831.  
  832. preferredBounds
  833.     "This tells the scrollbars how large the current document is,
  834.     so they can update themselves."
  835.  
  836.     ^self model bounds scaledBy: scale / 100!
  837.  
  838. toggleHandlesFor: aCollectionOfObjects on: aGC 
  839.         aGC translateBy: self offset.
  840.         aCollectionOfObjects do: [:o |
  841.                 o displayHandles do: [:h || rect image |
  842.                         rect := DrawHandle translatedBy: h * self displayScale.
  843.                         (aGC clippingBounds intersects: rect)
  844.                                 ifTrue: [rect := ((rect intersect: aGC clippingBounds)
  845.                                                                         translatedBy: aGC translation) rounded.
  846.                                                 (image := (aGC medium contentsOfArea: rect) first)
  847.                                                         copy: (0 @ 0 extent: rect extent)
  848.                                                         from: 0 @ 0
  849.                                                         in: image
  850.                                                         rule: 10;
  851.                                                         displayOn: aGC
  852.                                                         at: rect origin - aGC translation]]].
  853.         aGC translateBy: self offset negated! !
  854.  
  855. !SmallDrawView methodsFor: 'scaling'!
  856.  
  857. defaultScale
  858.         ^100!
  859.  
  860. displayScale
  861.         "Answer the screen scale factor, calculated from the percentage."
  862.         ^(self scale / 100) asPoint!
  863.  
  864. maxScale
  865.         ^3200!
  866.  
  867. minScale
  868.         ^25/2!
  869.  
  870. scale
  871.         ^scale!
  872.  
  873. scale100
  874.         self scale: 100!
  875.  
  876. scale12
  877.         self scale: self minScale!
  878.  
  879. scale1600
  880.         self scale: 1600!
  881.  
  882. scale200
  883.         self scale: 200!
  884.  
  885. scale25
  886.         self scale: 25!
  887.  
  888. scale3200
  889.         self scale: self maxScale!
  890.  
  891. scale400
  892.         self scale: 400!
  893.  
  894. scale50
  895.         self scale: 50!
  896.  
  897. scale800
  898.         self scale: 800!
  899.  
  900. scale: aNumber
  901.         scale := (aNumber abs min: self maxScale) max: self minScale.
  902.      self model scalePane: scale.
  903.         "self setToTop."
  904.         "self updateMarker."
  905.         self invalidateRectangle: self bounds repairNow: true.
  906.     self changedPreferredBounds: nil.!
  907.  
  908. zoomIn
  909.         self scale: (self scale * 2)!
  910.  
  911. zoomOut
  912.         self scale: (self scale / 2)! !
  913.  
  914. !SmallDrawView methodsFor: 'grid'!
  915.  
  916. gridOff
  917.     "Turn the grid off."
  918.  
  919.     useGrid := false.
  920.     controller updateMenu.!
  921.  
  922. gridOn
  923.     "Turn the grid on."
  924.  
  925.     useGrid := true.
  926.     controller updateMenu.!
  927.  
  928. scrollGrid
  929.         "Answer the receiver's grid for scrolling."
  930.         ^self useGrid
  931.                     ifTrue: [self model pasteOffset]
  932.             ifFalse: [1@1]!
  933.  
  934. toggleGrid
  935.     "Turn the grid on or off."
  936.  
  937.     useGrid := useGrid not.
  938.     controller updateMenu.!
  939.  
  940. useGrid
  941.         "Answer whether the grid is currently on."
  942.         ^useGrid! !
  943.  
  944. !SmallDrawView methodsFor: 'page breaks'!
  945.  
  946. pageBoundary
  947.         ^0@0 extent: self dataExtent * self displayScale!
  948.  
  949. pageBreakColor
  950.         ^ColorValue gray!
  951.  
  952. showPageBreaks
  953.         ^showPageBreaks!
  954.  
  955. togglePageBreaks
  956.         showPageBreaks := self showPageBreaks not.
  957.         self update: #pages! !
  958.  
  959. !SmallDrawView methodsFor: 'updating'!
  960.  
  961. repairRectangle: aRectangle 
  962.         self
  963.                 invalidateRectangle: (((aRectangle scaledBy: self displayScale) rounded
  964.                         expandedBy: (DrawHandle extent / 2) rounded) translatedBy: self offset)
  965.                 repairNow: true!
  966.  
  967. update: anAspectSymbol with: anObject
  968.  
  969.     container isNil ifTrue: [^self].    "too soon to do this"
  970.  
  971.         #add = anAspectSymbol
  972.                 ifTrue: [self displayObjects: anObject on: self graphicsContext;
  973.                                         toggleHandlesFor: anObject on: self graphicsContext].
  974.         #selection == anAspectSymbol
  975.                 ifTrue: [ self toggleHandlesFor: anObject on: self graphicsContext].
  976.         #rectangle == anAspectSymbol
  977.                 ifTrue: [self repairRectangle: anObject].
  978.         #pages == anAspectSymbol
  979.                 ifTrue: [self invalidate].
  980.       #zoomIn == anAspectSymbol
  981.             ifTrue: [self zoomIn.  self invalidate].
  982.       #zoomOut == anAspectSymbol
  983.             ifTrue: [self zoomOut.  self invalidate].! !
  984.  
  985. !SmallDrawView methodsFor: 'private'!
  986.  
  987. model: aModel
  988.         super model: aModel.
  989.         useGrid := true.
  990.         scale := self defaultScale.
  991.         showPageBreaks := true.!
  992.  
  993. offset
  994.     "patch to SmallDraw, 6-9-93 dka"
  995.     ^-1@-1! !
  996. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  997.  
  998. SmallDrawView class
  999.     instanceVariableNames: ''
  1000.  
  1001. "
  1002.     The following instance variables are inherited by this class: 
  1003.         View class -
  1004.         DependentPart class -
  1005.         VisualPart class -
  1006.         VisualComponent class -
  1007.         Object class -
  1008.         Class -- name, classPool, sharedPools
  1009.         ClassDescription -- instanceVariables, organization
  1010.         Behavior -- superclass, methodDict, format, subclasses
  1011.         Object -- 
  1012. "!
  1013.  
  1014.  
  1015. !SmallDrawView class methodsFor: 'handles'!
  1016.  
  1017. initialize
  1018.         "Initialize the size of the handles with a Rectangle centered at the origin."
  1019.         DrawHandle := (3@3) negated corner: (3@3).! !
  1020.  
  1021. ControllerWithMenu subclass: #SmallDrawController
  1022.     instanceVariableNames: ''
  1023.     classVariableNames: ''
  1024.     poolDictionaries: ''
  1025.     category: 'SmallDraw'
  1026.  
  1027. "
  1028.     The following instance variables are inherited by this class: 
  1029.         ControllerWithMenu -- menuHolder, performer
  1030.         Controller -- model, view, sensor
  1031.         Object -- 
  1032. "!
  1033. SmallDrawController comment:
  1034. 'I represent a controller that is able to accept mouse clicks to draw various  
  1035. graphics objects in my view. I use rubber-banding of lines to provide  
  1036. interactive feedback. Look at my creation methods. I am designed to be used  
  1037. with the model SmallDraw and view SmallDrawView.
  1038.  
  1039. When the Menu Bar or the yellowButton is pressed, the PopUpMenu defined in 
  1040. my yellowButtonMenu method is displayed.  Parts of this menu are to be carried
  1041. out by the model (SmallDraw), the view (SmallDrawView) or the controller (me).
  1042. Depending on user requests, the yellowButtonMenu may be updated dynamically.
  1043.  
  1044. When the redButton is pressed, I check to see whether the mouse touches any  
  1045. objects or whether I should rubber-band a rectangle to select a group of  
  1046. objects. If the mouse touches any objects, I either tell my model to select the 
  1047. object or I modify it in some way. If the mouse is on a handle point I scale  
  1048. the object, otherwise I translate it.
  1049.  
  1050. I reimplement methods that obtain mouse points from my input sensor because I  
  1051. want points to be fixed to my view''s displayGrid. If the shift button is down, 
  1052. I amplify the grid by a scaling factor.'!
  1053.  
  1054.  
  1055. !SmallDrawController methodsFor: 'accessing'!
  1056.  
  1057. gridMagnification
  1058.         "Answer the scale factor for the grid when the shift key is pressed."
  1059.         ^4!
  1060.  
  1061. rubberBandDelay
  1062.         "Answer the number of milliseconds for displaying rubberbanded shapes."
  1063.         ^25!
  1064.  
  1065. rubberBandLineWidth
  1066.         ^2! !
  1067.  
  1068. !SmallDrawController methodsFor: 'drawing'!
  1069.  
  1070. addNewEllipse
  1071.         "Obtain a sequence of mouse clicks from the user that define a rectangle. 
  1072.         Then ask the receiver's model to add a new ellipse based on this rectangle 
  1073.         to its collection of objects."
  1074.         | r savedCursor |
  1075.         savedCursor := Cursor currentCursor.
  1076.         Cursor currentCursor: Cursor origin.
  1077.         [self sensor anyButtonPressed] whileFalse.
  1078.         Cursor currentCursor: Cursor corner.
  1079.         r := self rectangleFromScreen.
  1080.         Cursor currentCursor: savedCursor.
  1081.         self model addObject: (SDEllipse origin: r origin corner: r corner)!
  1082.  
  1083. addNewLine
  1084.         "Obtain two mouse clicks from the user that define a line segment. Then 
  1085.         ask the receiver's model to add this new line to its collection of objects."
  1086.         | firstPoint aLine screen origin savedCursor lastPoint |
  1087.         savedCursor := Cursor currentCursor.
  1088.         Cursor currentCursor: Cursor crossHair.
  1089.         screen := Screen default.
  1090.         origin := self sensor globalOrigin.
  1091.         firstPoint := lastPoint := self waitButton.
  1092.         aLine := Array with: firstPoint with: lastPoint.
  1093.         [self sensor anyButtonPressed]
  1094.                 whileTrue: 
  1095.                         [screen
  1096.                                 displayShape: aLine
  1097.                                 lineWidth: self model lineWidth
  1098.                                 at: origin
  1099.                                 forMilliseconds: self rubberBandDelay.
  1100.                         aLine at: 2 put: self cursorPoint].
  1101.         Cursor currentCursor: savedCursor.
  1102.         self model addObject: (SDLineSegment start: (aLine at: 1)
  1103.                                 - self view offset / self view displayScale  end: (aLine at: 2)
  1104.                                 - self view offset / self view displayScale)!
  1105.  
  1106. addNewPolygon
  1107.         "Obtain a sequence of mouse clicks from the user that define a polygon. 
  1108.      Then ask the receiver's model to add this new polygon to its collection of objects."
  1109.  
  1110.         | firstPoint midPoint endPoint doubleClick aPolygon screen origin savedCursor |
  1111.         savedCursor := Cursor currentCursor.
  1112.         Cursor currentCursor: Cursor crossHair.
  1113.         screen := Screen default.
  1114.         origin := self sensor globalOrigin.
  1115. "Get the first click point."
  1116.         endPoint := firstPoint := midPoint := self waitClickButton.
  1117.         aPolygon := OrderedCollection with: firstPoint.
  1118.         doubleClick := false.
  1119. "Get a polygon, one click at a time."
  1120.         [doubleClick] whileFalse: [
  1121. "Wait for a mouse click"
  1122.                 [self sensor anyButtonPressed] whileFalse: [
  1123.                         screen
  1124.                                 displayShape: (Array
  1125.                                         with: aPolygon last
  1126.                                         with: (endPoint := self cursorPoint)
  1127.                                         with: aPolygon first)
  1128.                                 lineWidth: self model lineWidth
  1129.                                 at: origin
  1130.                                 forMilliseconds: self rubberBandDelay].
  1131. "Now wait for them to let go."
  1132.                 [self sensor anyButtonPressed] whileTrue: [
  1133.                         screen
  1134.                                 displayShape: (Array with: aPolygon last with: endPoint)
  1135.                                 lineWidth: self model lineWidth
  1136.                                 at: origin
  1137.                                 forMilliseconds: self rubberBandDelay].
  1138. "Draw the last segment obtained."
  1139.                 self view graphicsContext
  1140.                         lineWidth: self model lineWidth;
  1141.                         displayLineFrom: aPolygon last to: endPoint.
  1142.                 (doubleClick := (midPoint dist: endPoint) < 5)
  1143.                         ifFalse: [aPolygon addLast: endPoint].
  1144.                 midPoint := endPoint].
  1145.  
  1146.         Cursor currentCursor: savedCursor.
  1147. "Close the polygon."
  1148.         aPolygon addLast: aPolygon first.
  1149.         self model addObject: (SDPolygon vertices: (aPolygon collect: [:pt |
  1150.                 (pt - self view offset / self view displayScale) rounded]))!
  1151.  
  1152. addNewPolyline
  1153.         "Obtain a sequence of mouse clicks from the user that define a  
  1154. polyline. Then ask the receiver's model to add this new polyline to its  
  1155. collection of objects."
  1156.         | firstPoint midPoint endPoint doubleClick aPolyline screen origin savedCursor |
  1157.         savedCursor := Cursor currentCursor.
  1158.         Cursor currentCursor: Cursor crossHair.
  1159.         screen := Screen default.
  1160.         origin := self sensor globalOrigin.
  1161. "Get the first click point."
  1162.         firstPoint := midPoint := self waitClickButton.
  1163.         aPolyline := OrderedCollection with: firstPoint.
  1164.         doubleClick := false.
  1165. "Get a polyline, one click at a time."
  1166.         [doubleClick] whileFalse: [
  1167. "Wait for a mouse click"
  1168.                 [self sensor anyButtonPressed] whileFalse: [
  1169.                         screen
  1170.                                 displayShape: (Array with: aPolyline last with: (endPoint := self cursorPoint))
  1171.                                 lineWidth: self model lineWidth
  1172.                                 at: origin
  1173.                                 forMilliseconds: self rubberBandDelay].
  1174. "Now wait for them to let go."
  1175.                 [self sensor anyButtonPressed] whileTrue: [
  1176.                         screen
  1177.                                 displayShape: (Array with: aPolyline last with: endPoint)
  1178.                                 lineWidth: self model lineWidth
  1179.                                 at: origin
  1180.                                 forMilliseconds: self rubberBandDelay].
  1181. "Draw the last segment obtained."
  1182.                         self view graphicsContext
  1183.                                 lineWidth: self model lineWidth;
  1184.                                 displayLineFrom: aPolyline last to: endPoint.
  1185.                 (doubleClick := (midPoint dist: endPoint) < 5)
  1186.                         ifFalse: [aPolyline addLast: endPoint].
  1187.                 midPoint := endPoint].
  1188.         Cursor currentCursor: savedCursor.
  1189.         self model addObject: (SDPolyline vertices: (aPolyline collect: [:pt | 
  1190.                                 (pt - self view offset / self view displayScale) rounded]))!
  1191.  
  1192. addNewQuadrangle
  1193.         "Obtain a sequence of mouse clicks from the user that define a rectangle. 
  1194.         Then ask the receiver's model to add this new rectangle to its collection 
  1195.         of objects."
  1196.         | r savedCursor |
  1197.         savedCursor := Cursor currentCursor.
  1198.         Cursor currentCursor: Cursor origin.
  1199.         [self sensor anyButtonPressed] whileFalse.
  1200.         Cursor currentCursor: Cursor corner.
  1201.         r := self rectangleFromScreen.
  1202.         Cursor currentCursor: savedCursor.
  1203.         self model addObject: (SDQuadrangle origin: r origin corner: r corner)!
  1204.  
  1205. cornerOfRectangleFromScreenWithOrigin: aPoint
  1206.         "Answer the resulting corner of the rectangle with origin at aPoint  
  1207.     obtained from the user in the view's coordinate system. Assume the mouse is  
  1208.     already pressed."
  1209.         | origin rectangle polygon screen lastPoint newPoint |
  1210.         screen := Screen default.
  1211.         lastPoint := self cursorPoint.
  1212.         origin := self sensor globalOrigin.
  1213.         rectangle := Rectangle origin: aPoint corner: lastPoint.
  1214.         polygon := (Array new: 5)
  1215.                 at: 1 put: rectangle topLeft;
  1216.                 at: 2 put: rectangle topRight;
  1217.                 at: 3 put: rectangle bottomRight;
  1218.                 at: 4 put: rectangle bottomLeft;
  1219.                 at: 5 put: rectangle topLeft;
  1220.                 yourself.
  1221.         [self sensor anyButtonPressed]
  1222.                 whileTrue: 
  1223.                         [screen
  1224.                                 displayShape: polygon
  1225.                                 lineWidth: self rubberBandLineWidth
  1226.                                 at: origin
  1227.                                 forMilliseconds: self rubberBandDelay.
  1228.                         (newPoint := self cursorPoint) = lastPoint
  1229.                                 ifFalse: 
  1230.                                         [rectangle := (Rectangle vertex: aPoint
  1231.                                         vertex: (lastPoint := newPoint)) rounded.
  1232.                                         polygon
  1233.                                                 at: 1 put: rectangle topLeft;
  1234.                                                 at: 2 put: rectangle topRight;
  1235.                                                 at: 3 put: rectangle bottomRight;
  1236.                                                 at: 4 put: rectangle bottomLeft;
  1237.                                                 at: 5 put: rectangle topLeft]].
  1238.         ^lastPoint - self view offset!
  1239.  
  1240. endOfLineFromScreenWithOrigin: aPoint
  1241.         "Answer the resulting end of the line with one end at aPoint obtained  
  1242.     from the user in the view's coordinate system. Assume the mouse is already  
  1243.     pressed."
  1244.         | origin screen line |
  1245.         screen := Screen default.
  1246.         origin := self sensor globalOrigin.
  1247.         line := Array with: aPoint with: self cursorPoint.
  1248.         [self sensor anyButtonPressed]
  1249.                 whileTrue: 
  1250.                         [screen
  1251.                                 displayShape: line
  1252.                                 lineWidth: self rubberBandLineWidth
  1253.                                 at: origin
  1254.                                 forMilliseconds: self rubberBandDelay.
  1255.                         self cursorPoint = (line at: 2)
  1256.                                 ifFalse: 
  1257.                                         [line at: 2 put: self cursorPoint]].
  1258.         ^(line at: 2) - self view offset!
  1259.  
  1260. rectangleFromScreen
  1261.         "Answer the resulting rectangle obtained from the user in the view's  
  1262.     coordinate system. Assume the mouse is already pressed."
  1263.         | origin rectangle polygon screen lastPoint start newPoint |
  1264.         screen := Screen default.
  1265.         start := lastPoint := self cursorPoint.
  1266.         origin := self sensor globalOrigin.
  1267.         rectangle := Rectangle origin: start corner: lastPoint.
  1268.         polygon := Array new: 5 withAll: start.
  1269.         [self sensor anyButtonPressed]
  1270.                 whileTrue: 
  1271.                         [screen
  1272.                                 displayShape: polygon
  1273.                                 lineWidth: self rubberBandLineWidth
  1274.                                 at: origin
  1275.                                 forMilliseconds: self rubberBandDelay.
  1276.                         (newPoint := self cursorPoint) = lastPoint
  1277.                                 ifFalse: 
  1278.                                         [rectangle := Rectangle vertex: start  
  1279.                                         vertex: (lastPoint := newPoint).
  1280.                                         polygon
  1281.                                                 at: 1 put: rectangle topLeft;
  1282.                                                 at: 2 put: rectangle topRight;
  1283.                                                 at: 3 put: rectangle bottomRight;
  1284.                                                 at: 4 put: rectangle bottomLeft;
  1285.                                                 at: 5 put: rectangle topLeft]].
  1286.         ^(rectangle moveBy: self view offset negated)
  1287.                 scaledBy: self view displayScale reciprocal! !
  1288.  
  1289. !SmallDrawController methodsFor: 'interaction'!
  1290.  
  1291. clickOnObject: anObject at: aModelPoint
  1292.         "The user is clicking on anObject at aModelPoint. If anObject is  
  1293.     already selected we either de-select it or modify it. If it's not already  
  1294.     selected we select it (possibly extending the selection), wait momentarily, and 
  1295.     then if the mouse remains pressed we translate it. The pause is added so that  
  1296.     objects won't get moved accidently."
  1297.         (self model selectedObjects includes: anObject)
  1298.                 ifTrue: [self sensor shiftDown
  1299.                         ifTrue: [self model selectObject: anObject extend:  true]
  1300.                         ifFalse: [self modifyObject: anObject at: aModelPoint]]
  1301.                 ifFalse: [self model selectObject: anObject extend: self sensor shiftDown.
  1302.                                 (Delay forMilliseconds: 20) wait.
  1303.                                 self sensor anyButtonPressed
  1304.                                         ifTrue: [self translateObject: anObject]]!
  1305.  
  1306. modifyObject: anObject at: aModelPoint
  1307.         "If the cursorPoint is on a handle point of anObject we scale it,  
  1308.     otherwise we translate it."
  1309.         | handle |
  1310.         (handle := anObject displayHandles
  1311.                         detect: [:h | self view handle containsPoint: aModelPoint - h]
  1312.                         ifNone: [nil]) notNil
  1313.                 ifTrue: [self scaleObject: anObject usingHandle: handle]
  1314.                 ifFalse: [self translateObject: anObject]!
  1315.  
  1316. objectHitBy: aModelPoint
  1317.         "Answer the single object that is touched by aModelPoint. Selected  
  1318.     objects have preference if one of their handles is touched. Otherwise answer  
  1319.     the first object hit, or nil."
  1320.         self model selectedObjects do: [:each | 
  1321.                 each displayHandles do: [:pt |
  1322.                         (self view handle containsPoint: aModelPoint - pt)
  1323.                                 ifTrue: [^each]]].
  1324.         self model allObjects do: [:each |
  1325.                 (each containsPoint: aModelPoint)
  1326.                         ifTrue: [^each]].
  1327.         ^nil!
  1328.  
  1329. objectsInRectangle: aRectangle
  1330.         "Determine the objects contained in aRectangle."
  1331.         ^self model allObjects select: [:o | o insideRectangle: aRectangle]!
  1332.  
  1333. scaleObject: anObject usingHandle: aHandlePoint
  1334.         "The cursor is over the handle at aHandlePoint. The opposite handle  
  1335.     point should remain stationary (anchorHandle) as the cursor is moved."
  1336.         |scale anchorHandle newPoint scaleFactor bbox testObject |
  1337.         scale := self view displayScale.
  1338.         anchorHandle := anObject handleOpposite: aHandlePoint.
  1339.         newPoint := (anObject animateUsingRectangle
  1340.                 ifTrue: [self cornerOfRectangleFromScreenWithOrigin:  
  1341.                     (anchorHandle * scale) + self view offset]
  1342.                 ifFalse: [self endOfLineFromScreenWithOrigin:
  1343.                     (anchorHandle * scale) + self view offset]) / scale.
  1344.  
  1345. "NOTE: If the object being scaled isSquished (either vertical or horizontal),  
  1346.     it will have a zero in its original vector diagonal so scaling should be done  
  1347.     in absolute terms and the percentage is calculated from the resulting  
  1348.     unitVector multiplied by the ratio of the newDiagonalDistance over the  
  1349.     oldDiagonalDistance. Absolute scaling should only be performed by other  
  1350.     'squished' objects.
  1351.         If the object being scaled is not squished there is no danger of  
  1352.     division by zero so the percentage is calculated from the ratio of the  
  1353.     newDiagonalVector divided by the oldDiagonalVector."
  1354.         scaleFactor := anObject isSquished
  1355.                                         ifTrue: [(newPoint - anchorHandle)  unitVector  *
  1356.                                                                 ((newPoint  dist: anchorHandle) /
  1357.                                                                         (aHandlePoint dist: anchorHandle))]
  1358.                                         ifFalse: [(newPoint - anchorHandle) /
  1359.                                                                 (aHandlePoint - anchorHandle)].
  1360. "In bounds check."
  1361.         bbox := self model selectedObjectsDisplayBox.
  1362.         testObject := SDQuadrangle origin: bbox origin corner: bbox corner.
  1363.         testObject
  1364.                 scaleBy: scaleFactor
  1365.                 aboutHandleAt: (anObject indexOfHandle: anchorHandle)
  1366.                 absolute: anObject isSquished.
  1367.         (testObject origin x < 0 or: [testObject origin y < 0])
  1368.                 ifFalse: [self model
  1369.                         scaleBy: scaleFactor
  1370.                         aboutHandleAt: (anObject indexOfHandle: anchorHandle)
  1371.                         absolute: anObject isSquished]
  1372.                 ifTrue: [Screen default ringBell]!
  1373.  
  1374. translateObject: anObject
  1375.         | screen end start scale outline bbox bb origin newPoint |
  1376.         screen := Screen default.
  1377.         start := end := self cursorPoint.
  1378.         scale := self view displayScale.
  1379.     "Display the outline of the first object in the collection and the boundingBox  
  1380.     of the entire collection of objects (if applicable)."
  1381.         outline := anObject outline collect: [:pt | (pt * scale) rounded].
  1382.         bbox := (self model selectedObjectsDisplayBox scaledBy: scale) rounded.
  1383.         bb := (self model selectedObjects size > 1
  1384.                 ifTrue: [(Array new: 5)
  1385.                                         at: 1 put: bbox origin;
  1386.                                         at: 2 put: bbox topRight;
  1387.                                         at: 3 put: bbox corner;
  1388.                                         at: 4 put: bbox bottomLeft;
  1389.                                         at: 5 put: bbox origin;
  1390.                                         yourself]
  1391.                 ifFalse: [nil]).
  1392.  
  1393.         origin := self sensor globalOrigin + self view offset - start.
  1394.         [self sensor anyButtonPressed]
  1395.                 whileTrue: [screen
  1396.                                                 displayShape: outline
  1397.                                                 lineWidth: self rubberBandLineWidth
  1398.                                                 at: origin + end
  1399.                                                 forMilliseconds: self rubberBandDelay;
  1400.  
  1401.                                                 displayShape: bb
  1402.                                                 lineWidth: self rubberBandLineWidth
  1403.                                                 at: origin + end
  1404.                                                 forMilliseconds: self rubberBandDelay.
  1405.                         end := self cursorPoint].
  1406.         newPoint := (bbox translatedBy: (end - start)) origin.
  1407.         (newPoint x < 0 or: [newPoint y < 0])
  1408.                 ifFalse: [self model translateBy: (end - start) / scale]
  1409.                 ifTrue: [Screen default ringBell]! !
  1410.  
  1411. !SmallDrawController methodsFor: 'menu'!
  1412.  
  1413. initializeMenu
  1414.     "Define the initial yellowButtonMenu.  This will be changed at runtime
  1415.     according to the grid on|off state in the view."
  1416.  
  1417.     ^menuHolder :=  (ValueHolder with: self yellowButtonMenu)!
  1418.  
  1419. menuMessageReceiver
  1420.     ^model!
  1421.  
  1422. updateMenu
  1423.     self menuHolder value: self yellowButtonMenu!
  1424.  
  1425. yellowButtonMenu
  1426.     "Define and answer the yellowButtonMenu.  
  1427.     This menu defines actions that are to be carried out by either the
  1428.     model (SmallDraw), view (SmallDrawView) or controller (SmallDrawController).
  1429.     The different means of defining actions and receivers are noted below.
  1430.     The current version of this method assumes there is an instance method 
  1431.     SmallDrawController>>menuMessageReceiver, which answers the model."
  1432.  
  1433.     | mb |
  1434.     mb := MenuBuilder new.
  1435.     mb 
  1436.         beginSubMenuLabeled: 'Edit';
  1437.             "note: these actions will be sent to the controller's menuMessageReceiver"
  1438.             add: 'copy'->#copy;
  1439.             add: 'cut'->#cut;
  1440.             add: 'paste'->#paste;
  1441.             line;
  1442.             add: 'select all'->#selectAll;
  1443.             add: 'duplicate'->#duplicate;
  1444.             endSubMenu;
  1445.         line;
  1446.         beginSubMenuLabeled: 'Draw';
  1447.             beginSubMenuLabeled: 'new';
  1448.                 "note: these actions will be executed by evaluating the blocks"
  1449.                 add: 'line'->[:c | self addNewLine];
  1450.                 add: 'polyline'->[:c | self addNewPolyline];
  1451.                 add: 'rectangle'->[:c | self addNewQuadrangle];
  1452.                 add: 'polygon'->[:c | self addNewPolygon];
  1453.                 add: 'ellipse'->[:c | self addNewEllipse];
  1454.                 endSubMenu;
  1455.             line;
  1456.             add: 'inside color...'->#changeInsideColor;
  1457.             add: 'border color...'->#changeBorderColor;
  1458.             add: 'line width...'->#changeLineWidth;
  1459.             line;
  1460.             beginSubMenuLabeled: 'bring';
  1461.                 add: 'forward'->#moveForward;
  1462.                 add: 'to front'->#moveToFront;
  1463.                 endSubMenu;
  1464.             beginSubMenuLabeled: 'send';
  1465.                 add: 'backward'->#moveBackward;
  1466.                 add: 'to back'->#moveToBack;
  1467.                 endSubMenu;
  1468.             line;
  1469.             add: 'group'->#group;
  1470.             add: 'ungroup'->#unGroup;
  1471.             add: 'align...'->#alignDialog;
  1472.             endSubMenu;
  1473.         line;
  1474.         beginSubMenuLabeled: 'View';
  1475.             "note:  these actions are carried out by the SmallDrawView"
  1476.             add: 'refresh'->[:c | view invalidate];
  1477.             line;
  1478.             add: 'zoom in'->[:c | view zoomIn];
  1479.             add: 'zoom out'->[:c | view zoomOut];
  1480.             line;
  1481.             add: 'grid ',     "during initialization, 'view' has not been set yet"
  1482.                 (view isNil ifTrue: ['off'] ifFalse: [
  1483.                     (view useGrid ifTrue: [ 'off' ] ifFalse: [ 'on' ])
  1484.                     ]) ->[:c | view toggleGrid];
  1485.             line;
  1486.             "note: this action is carried out by the SmallDraw object itself"
  1487.             add: 'reset pages'->[:c | model setSmallestPages];
  1488.             endSubMenu.
  1489.     ^mb menu.! !
  1490.  
  1491. !SmallDrawController methodsFor: 'sensor access'!
  1492.  
  1493. cursorPoint
  1494.         "Answer the current cursor point, fixing it to the grid. If the shift  
  1495.     key is pressed the grid is magnified so that it's easier to constrain movements 
  1496.      along either axis."
  1497.         ^self sensor shiftDown
  1498.                 ifTrue: [self sensor cursorPoint grid: self view scrollGrid *  self gridMagnification]
  1499.                 ifFalse: [self sensor cursorPoint grid: self view scrollGrid]!
  1500.  
  1501. processKeyboard
  1502.         "Determine whether the user pressed the keyboard.  If so, read the key  and pass it on to the model."
  1503.  
  1504.         self sensor keyboardPressed
  1505.         ifTrue: [ | keyHit | 
  1506.             keyHit := self sensor keyboardEvent keyValue.
  1507.             "Check for backspace here."
  1508.             keyHit = Character backspace 
  1509.                 ifTrue: [self model processCommandKey: keyHit].
  1510.             (self sensor altDown or: [self sensor metaDown]) 
  1511.                 ifTrue: [
  1512.                     "KeyValues are lowercase so we must convert to uppercase if the shift key is  down."
  1513.                             self sensor shiftDown ifTrue: [keyHit := keyHit asUppercase].
  1514.                             self model processCommandKey: keyHit]]!
  1515.  
  1516. waitButton
  1517.         "Wait for the user to press any mouse button and then answer with the  
  1518.     current location of the cursor fixed to the grid. If the shift key is pressed  
  1519.     the grid is magnified so that it's easier to constrain movements along either  
  1520.     axis."
  1521.         ^self sensor shiftDown
  1522.                 ifTrue: [self sensor waitButton grid: self view scrollGrid * self gridMagnification]
  1523.                 ifFalse: [self sensor waitButton grid: self view scrollGrid]!
  1524.  
  1525. waitClickButton
  1526.         "Wait for the user to click (press and then release) any mouse button  
  1527.     and then answer with the current location of the cursor fixed to the grid. If  
  1528.     the shift key is pressed the grid is magnified so that it's easier to constrain 
  1529.      movements along either axis."
  1530.  
  1531.         ^self sensor shiftDown
  1532.                 ifTrue: [self sensor waitClickButton grid: self view scrollGrid * self gridMagnification]
  1533.                 ifFalse: [self sensor waitClickButton grid: self view scrollGrid]! !
  1534.  
  1535. !SmallDrawController methodsFor: 'control'!
  1536.  
  1537. controlActivity 
  1538.         "First check the keyboard and then do the usual."
  1539.         self processKeyboard.
  1540.         super controlActivity.!
  1541.  
  1542. redButtonActivity
  1543.         "Process either a single object selection or range selection in a  
  1544. rectangle."
  1545.         | hitObject modelPoint|
  1546.     "NOTE: the first point obtained should not be fixed to the grid. Otherwise it  
  1547.     may be impossible to select some objects by their edge!!"
  1548.         modelPoint := ((self sensor cursorPoint - self view offset) / self view displayScale) rounded.
  1549.         (hitObject := self objectHitBy: modelPoint) notNil
  1550.                 ifTrue: [self clickOnObject: hitObject at: modelPoint]
  1551.                 ifFalse: [self model selectRange: (self objectsInRectangle:  self rectangleFromScreen)
  1552.                                                         extend: self sensor shiftDown]! !
  1553.  
  1554.  
  1555. Object subclass: #SDGraphicObject
  1556.     instanceVariableNames: 'insideColor borderColor lineWidth handles boundingBox '
  1557.     classVariableNames: ''
  1558.     poolDictionaries: ''
  1559.     category: 'SmallDraw'
  1560.  
  1561. "
  1562.     The following instance variables are inherited by this class: 
  1563.         Object -- 
  1564. "!
  1565. SDGraphicObject comment:
  1566. 'I represent the abstract superclass of all SmallDraw graphic objects. I define  
  1567. instance variables for visual attributes used when displaying my instances and  
  1568. I have methods for accessing and setting these attributes.
  1569.  
  1570. I am also able to translate and scale myself. Of course, this must be done by  
  1571. concrete subclasses.
  1572.  
  1573. I keep track of my handle points that are used to indicate that I am selected  
  1574. and for manipulating myself.
  1575.  
  1576. Concrete subclasses are responsible for displaying themselves at a particular  
  1577. scale using the method:
  1578.  
  1579.     displayOn: aGraphicsContext scale: aScalePoint
  1580.  
  1581. In addition, I implement a method deepCopy to specify how to properly create
  1582. a copy of a graphic object and its instance variables, for use with the copy/paste
  1583. clipboard.  Subclasses which add instance variables should override this method
  1584. to extend it as needed (see SDGraphicGroup>>deepCopy and other examples).
  1585.  
  1586. I have the following instance variables:
  1587.  
  1588. insideColor     <ColorValue>    the inside color
  1589. borderColor     <ColorValue>    the border color
  1590. lineWidth               <Integer>       the line width
  1591. handles         <Array> four points used for manipulating objects
  1592. boundingBox     <Rectangle>     minimum bounding rectangle of object'!
  1593.  
  1594.  
  1595. !SDGraphicObject methodsFor: 'accessing'!
  1596.  
  1597. borderColor
  1598.         ^borderColor!
  1599.  
  1600. borderColor: aColorValue
  1601.         borderColor := aColorValue!
  1602.  
  1603. boundingBox
  1604.         boundingBox isNil
  1605.                 ifTrue: [self computeBoundingBox].
  1606.         ^boundingBox!
  1607.  
  1608. center
  1609.         ^self boundingBox center!
  1610.  
  1611. defaultLineWidth
  1612.         ^1!
  1613.  
  1614. displayBox
  1615.         ^self boundingBox expandedBy: (1 max: (self lineWidth/2) truncated)  asPoint!
  1616.  
  1617. displayHandles
  1618.         "Answer the handles to use for displaying the receiver."
  1619.         ^self isSquished
  1620.                 ifTrue: [Array with: self boundingBox origin with: self  boundingBox corner]
  1621.                 ifFalse: [self handles]!
  1622.  
  1623. handleOpposite: aHandlePoint
  1624.         "Answer the handle point that is the opposite corner of aHandlePoint."
  1625.         (self handles at: 3) = aHandlePoint
  1626.                 ifTrue: [^self handles at: 1].
  1627.         (self handles at: 4) = aHandlePoint
  1628.                 ifTrue: [^self handles at: 2].
  1629.         (self handles at: 1) = aHandlePoint
  1630.                 ifTrue: [^self handles at: 3].
  1631.         (self handles at: 2) = aHandlePoint
  1632.                 ifTrue: [^self handles at: 4].!
  1633.  
  1634. handles
  1635.         ^handles!
  1636.  
  1637. height
  1638.         ^self boundingBox height!
  1639.  
  1640. indexOfHandle: aHandlePoint
  1641.         "Answer the handle point that is the opposite corner of aHandlePoint."
  1642.         1 to: self handles size do: [:i | (self handles at: i) = aHandlePoint  ifTrue: [^i]].
  1643.         self error: 'Something went wrong.'!
  1644.  
  1645. insideColor
  1646.         ^insideColor!
  1647.  
  1648. insideColor: aColorValue
  1649.         insideColor := aColorValue!
  1650.  
  1651. lineWidth
  1652.         lineWidth isNil
  1653.                 ifTrue: [lineWidth := self defaultLineWidth].
  1654.         ^lineWidth!
  1655.  
  1656. lineWidth: anInteger
  1657.         lineWidth := anInteger rounded.
  1658.         self computeBoundingBox!
  1659.  
  1660. origin
  1661.         ^self boundingBox origin!
  1662.  
  1663. width
  1664.         ^self boundingBox width! !
  1665.  
  1666. !SDGraphicObject methodsFor: 'displaying'!
  1667.  
  1668. displayOn: aGC scale: aScalePoint
  1669.         self subclassResponsibility!
  1670.  
  1671. joinStyle
  1672.         "Answer the appropriate join style for displaying the receiver."
  1673.         ^GraphicsContext joinBevel! !
  1674.  
  1675. !SDGraphicObject methodsFor: 'converting'!
  1676.  
  1677. outline
  1678.         "Answer an array of 5 points representing a closed polygon of the  
  1679. receiver's 4 handle points."
  1680.         ^(Array new: 5)
  1681.                 at: 1 put: (self handles at: 1);
  1682.                 at: 2 put: (self handles at: 2);
  1683.                 at: 3 put: (self handles at: 3);
  1684.                 at: 4 put: (self handles at: 4);
  1685.                 at: 5 put: (self handles at: 1);
  1686.                 yourself! !
  1687.  
  1688. !SDGraphicObject methodsFor: 'manipulation'!
  1689.  
  1690. scaleAbsoluteBy: aPercentagePoint aboutHandleAt: anIndex
  1691.         "aPercentagePoint is calculated as (unitVector) * (newDiagonalDistance  
  1692.     / oldDiagonalDistance). This is appropriate when the object being scaled was  
  1693.     also squished."
  1694.         self subclassResponsibility!
  1695.  
  1696. scaleBy: aPercentagePoint aboutHandleAt: anIndex absolute: aBoolean
  1697.         "aPercentagePoint is specified in two different ways according to aBoolean.
  1698.         If aBoolean is true, the object being scaled was squished  
  1699.     (either vertical or horizontal) which means that it will have a zero in its  
  1700.     original diagonal vector so scaling should be done in absolute terms and  
  1701.     aPercentagePoint is specified by the resulting unitVector multiplied by the  
  1702.     ratio of the newDiagonalDistance over the oldDiagonalDistance. Absolute scaling 
  1703.      is only performed by the receiver if the receiver is also squished.
  1704.                 If aBoolean is false there is no danger of division by zero so  
  1705.     aPercentagePoint is specified by the ratio of newDiagonalVector /  oldDiagonalVector.
  1706.         All scaling is done relative to the receiver's handle point at  anIndex."
  1707.         aBoolean
  1708.                 ifTrue: [self isSquished
  1709.                         ifTrue: [self scaleAbsoluteBy: aPercentagePoint  aboutHandleAt: anIndex]]
  1710.                 ifFalse: [self scaleRelativeBy: aPercentagePoint aboutHandleAt: anIndex]!
  1711.  
  1712. scaleRelativeBy: aPercentagePoint aboutHandleAt: anIndex
  1713.         "aPercentagePoint is calculated as (newDiagonalVector /  
  1714.     oldDiagonalVector). The receiver should be scaled proportionally to the ratio  
  1715.     of its boundingBox diagonal."
  1716.         self subclassResponsibility!
  1717.  
  1718. translateBy: aPoint
  1719.         self subclassResponsibility! !
  1720.  
  1721. !SDGraphicObject methodsFor: 'private'!
  1722.  
  1723. computeBoundingBox
  1724.         self subclassResponsibility!
  1725.  
  1726. setBoundingBox: aRectangle
  1727.         "Set the receiver's boundingBox and update its handles."
  1728.         boundingBox := aRectangle.
  1729.         self setHandles!
  1730.  
  1731. setHandles
  1732.         "For consistency, handles should be set in a clockwise direction."
  1733.         handles := Array 
  1734.                 with: self boundingBox origin
  1735.                 with: self boundingBox topRight
  1736.                 with: self boundingBox corner
  1737.                 with: self boundingBox bottomLeft! !
  1738.  
  1739. !SDGraphicObject methodsFor: 'testing'!
  1740.  
  1741. animateUsingRectangle
  1742.         "Answer whether a rectangle should be used in animating the receiver when scaling."
  1743.         ^true!
  1744.  
  1745. containsPoint: aPoint
  1746.         ^(self boundingBox containsPoint: aPoint)
  1747.                 ifTrue: [self isHollow
  1748.                         ifTrue: [self edgeContainsPoint: aPoint]
  1749.                         ifFalse: [(self interiorContainsPoint: aPoint)
  1750.                                                 or: [self edgeContainsPoint:  aPoint]]]
  1751.                 ifFalse: [false]!
  1752.  
  1753. edgeContainsPoint: aPoint
  1754.         self subclassResponsibility!
  1755.  
  1756. insideRectangle: aRectangle
  1757.         "Answer whether the receiver is entirely inside aRectangle."
  1758.         ^aRectangle contains: self boundingBox!
  1759.  
  1760. interiorContainsPoint: aPoint
  1761.         self subclassResponsibility!
  1762.  
  1763. isHollow
  1764.         ^self insideColor isNil!
  1765.  
  1766. isSquished
  1767.         "Answer whether the receiver is either totally horizontal or totally  
  1768. vertical."
  1769.         ^(self width isZero or: [self height isZero])!
  1770.  
  1771. tolerance
  1772.         "Answer the minimum distance that a point can be from an edge of the  
  1773.     receiver to constitute a 'hit'. Actually, this number should probably be  
  1774.     determined by the current scale of the view because reduced views require a  
  1775.     larger tolerance, in which case it should be passed as an argument from the  
  1776.     controller."
  1777.         ^(self lineWidth/2) truncated + 8! !
  1778.  
  1779. !SDGraphicObject methodsFor: 'copying'!
  1780.  
  1781. deepCopy
  1782.     "Answer a copy of self with copies of instance variables I define.
  1783.     Subclasses that define additional instance variables may want to override me."
  1784.  
  1785.     ^self copy
  1786.         insideColor: self insideColor copy;
  1787.         borderColor: self borderColor copy;
  1788.         lineWidth: self lineWidth copy;
  1789.         handles: (self handles collect: [ :h | h copy ]);
  1790.         boundingBox: self boundingBox copy;
  1791.         yourself.! !
  1792.  
  1793. SDGraphicObject subclass: #SDLineSegment
  1794.     instanceVariableNames: 'start end '
  1795.     classVariableNames: ''
  1796.     poolDictionaries: ''
  1797.     category: 'SmallDraw'
  1798.  
  1799. "
  1800.     The following instance variables are inherited by this class: 
  1801.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  1802.         Object -- 
  1803. "!
  1804.  
  1805.  
  1806. !SDLineSegment methodsFor: 'accessing'!
  1807.  
  1808. displayHandles
  1809.         ^Array with: self start with: self end!
  1810.  
  1811. end
  1812.         ^end!
  1813.  
  1814. start
  1815.         ^start!
  1816.  
  1817. start: thisPoint end: thatPoint
  1818.         thisPoint x < thatPoint x
  1819.                 ifTrue: [start := thisPoint. end := thatPoint]
  1820.                 ifFalse: [start := thatPoint. end := thisPoint].
  1821.         start := start rounded. end := end rounded.
  1822.         self computeBoundingBox! !
  1823.  
  1824. !SDLineSegment methodsFor: 'converting'!
  1825.  
  1826. outline
  1827.         ^self displayHandles! !
  1828.  
  1829. !SDLineSegment methodsFor: 'displaying'!
  1830.  
  1831. displayOn: aGC scale: aScalePoint
  1832.         self borderColor isNil
  1833.                 ifFalse: [aGC
  1834.                                         paint: self borderColor;
  1835.                                         lineWidth: self lineWidth;
  1836.                                         displayLineFrom: (self start *  aScalePoint)
  1837.                                 to: (self end * aScalePoint)].! !
  1838.  
  1839. !SDLineSegment methodsFor: 'manipulation'!
  1840.  
  1841. scaleAbsoluteBy: aPercentagePoint aboutHandleAt: anIndex
  1842.         (self handles at: anIndex) = self start
  1843.                 ifTrue: [self start: self start
  1844.                                         end: self start + (aPercentagePoint *  (self start dist: self end))]
  1845.                 ifFalse: [self start: self end + (aPercentagePoint * (self  start dist: self end))
  1846.                                         end: self end]!
  1847.  
  1848. scaleRelativeBy: aPercentagePoint aboutHandleAt: anIndex
  1849.         | anchor |
  1850.         anchor := self handles at: anIndex.
  1851.         self start: ((self start - anchor) * aPercentagePoint) + anchor
  1852.                 end: ((self end - anchor) * aPercentagePoint) + anchor!
  1853.  
  1854. translateBy: aPoint
  1855.         self start: self start + aPoint end: self end + aPoint! !
  1856.  
  1857. !SDLineSegment methodsFor: 'private'!
  1858.  
  1859. computeBoundingBox
  1860.         self setBoundingBox: (Rectangle vertex: self start vertex: self end)! !
  1861.  
  1862. !SDLineSegment methodsFor: 'testing'!
  1863.  
  1864. animateUsingRectangle
  1865.         ^false!
  1866.  
  1867. containsPoint: aPoint
  1868.         ^self edgeContainsPoint: aPoint!
  1869.  
  1870. edgeContainsPoint: aPoint
  1871.         "Answer whether any one of the receiver's edges contains aPoint. This  
  1872.     is true if aPoint is within a certain distance from an edge - see message:  
  1873.     tolerance."
  1874.         ^((aPoint nearestIntegerPointOnLineFrom: self start to: self end)
  1875.         dist: aPoint) <= self tolerance! !
  1876.  
  1877. !SDLineSegment methodsFor: 'copying'!
  1878.  
  1879. deepCopy
  1880.     "Answer a copy of self with copies of instance variables I define.
  1881.     Subclasses that define additional instance variables may want to override me."
  1882.  
  1883.     ^self copy
  1884.         start: self start copy
  1885.         end: self end copy! !
  1886. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1887.  
  1888. SDLineSegment class
  1889.     instanceVariableNames: ''
  1890.  
  1891. "
  1892.     The following instance variables are inherited by this class: 
  1893.         SDGraphicObject class -
  1894.         Object class -
  1895.         Class -- name, classPool, sharedPools
  1896.         ClassDescription -- instanceVariables, organization
  1897.         Behavior -- superclass, methodDict, format, subclasses
  1898.         Object -- 
  1899. "!
  1900.  
  1901.  
  1902. !SDLineSegment class methodsFor: 'instance creation'!
  1903.  
  1904. from: thisPoint to: thatPoint
  1905.         ^self start: thisPoint end: thatPoint!
  1906.  
  1907. start: thisPoint end: thatPoint
  1908.         ^self new start: thisPoint end: thatPoint! !
  1909.  
  1910. SDGraphicObject subclass: #SDPolyline
  1911.     instanceVariableNames: 'vertices '
  1912.     classVariableNames: ''
  1913.     poolDictionaries: ''
  1914.     category: 'SmallDraw'
  1915.  
  1916. "
  1917.     The following instance variables are inherited by this class: 
  1918.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  1919.         Object -- 
  1920. "!
  1921.  
  1922.  
  1923. !SDPolyline methodsFor: 'accessing'!
  1924.  
  1925. vertices
  1926.         ^vertices!
  1927.  
  1928. vertices: aCollectionOfPoints
  1929.         vertices := aCollectionOfPoints asArray.
  1930.         self computeBoundingBox! !
  1931.  
  1932. !SDPolyline methodsFor: 'converting'!
  1933.  
  1934. outline
  1935.         ^self vertices! !
  1936.  
  1937. !SDPolyline methodsFor: 'displaying'!
  1938.  
  1939. displayOn: aGC scale: aScalePoint
  1940.         | displayPoints |
  1941.         aGC joinStyle: self joinStyle.
  1942.         displayPoints := self vertices collect: [:pt | pt * aScalePoint].
  1943.         self insideColor isNil
  1944.                 ifFalse: [aGC
  1945.                                         paint: self insideColor;
  1946.                                         displayPolygon: displayPoints].
  1947.         self borderColor isNil
  1948.                 ifFalse: [aGC
  1949.                                         paint: self borderColor;
  1950.                                         lineWidth: self lineWidth;
  1951.                                         displayPolyline: displayPoints].! !
  1952.  
  1953. !SDPolyline methodsFor: 'manipulation'!
  1954.  
  1955. scaleAbsoluteBy: aPercentagePoint aboutHandleAt: anIndex
  1956.         | anchor |
  1957.         anchor := self handles at: anIndex.
  1958.         self
  1959.         vertices: (Array with: anchor
  1960.                         with: anchor + (aPercentagePoint *  
  1961.                                     (anchor dist: (self handleOpposite: anchor))))!
  1962.  
  1963. scaleRelativeBy: aPercentagePoint aboutHandleAt: anIndex
  1964.         | anchor |
  1965.         anchor := self handles at: anIndex.
  1966.         self vertices: (self vertices collect: [:pt |
  1967.                 (((pt - anchor) * aPercentagePoint) + anchor) rounded])!
  1968.  
  1969. translateBy: aPoint
  1970.         self vertices: (self vertices collect: [:pt | pt + aPoint])! !
  1971.  
  1972. !SDPolyline methodsFor: 'private'!
  1973.  
  1974. computeBoundingBox
  1975.         | minPoint maxPoint |
  1976.         minPoint := maxPoint := self vertices first.
  1977.         self vertices do: [:each |
  1978.                 minPoint := minPoint min: each.
  1979.                 maxPoint := maxPoint max: each].
  1980.         self setBoundingBox: (Rectangle origin: minPoint corner: maxPoint)! !
  1981.  
  1982. !SDPolyline methodsFor: 'testing'!
  1983.  
  1984. edgeContainsPoint: aPoint
  1985.         "Answer whether any one of the receiver's edges contains aPoint. This  
  1986.     is true if aPoint is within a certain distance from an edge - see message:  
  1987.     tolerance."
  1988.         | delta from |
  1989.         delta := self tolerance.
  1990.         from := self outline first.
  1991.         self outline do: [:pt |
  1992.                 ((aPoint nearestIntegerPointOnLineFrom: from to: pt ) dist:  aPoint) <= delta
  1993.                         ifTrue: [^true].
  1994.                 from := pt].
  1995.         ^false!
  1996.  
  1997. interiorContainsPoint: aPoint
  1998.         "Answer whether the receiver contains aPoint on its boundary or in its  
  1999.     interior.  Uses the winding technique.  See the method  
  2000.     Point|quadrantContaining:. "
  2001.         | wind lastPoint oldQuad newQuad |
  2002.         wind := 0.
  2003.         lastPoint := self vertices last.
  2004.         oldQuad := lastPoint quadrantContaining: aPoint.
  2005.         self vertices do: [:each |
  2006.                 aPoint = each ifTrue: [^true].
  2007.                 newQuad := each quadrantContaining: aPoint.
  2008.                 oldQuad = newQuad
  2009.                         ifFalse: [oldQuad+1\\4 = newQuad
  2010.                                 ifTrue: [wind := wind + 1]
  2011.                                 ifFalse: [newQuad+1\\4 = oldQuad
  2012.                                         ifTrue: [wind := wind - 1]
  2013.                                         ifFalse: [| a b |
  2014.                                                         a := lastPoint y - each y.
  2015.                                                         a := a * (aPoint x - lastPoint x).
  2016.                                                         b := lastPoint x - each x.
  2017.                                                         a := a + (b * lastPoint y).
  2018.                                                         b := b * aPoint y.
  2019.                                                         a > b
  2020.                                                                 ifTrue: [wind := wind - 2]
  2021.                                                                 ifFalse: [a = b ifTrue:[^true] ifFalse: [wind := wind + 2]]]]].
  2022.                 oldQuad := newQuad.
  2023.                 lastPoint := each].
  2024.         ^wind isZero not! !
  2025.  
  2026. !SDPolyline methodsFor: 'copying'!
  2027.  
  2028. deepCopy
  2029.     "Answer a copy of self with copies of instance variables I define.
  2030.     Subclasses that define additional instance variables may want to override me."
  2031.  
  2032.     ^super copy
  2033.         vertices: (self vertices collect: [ :v | v copy ]);
  2034.         yourself.! !
  2035. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2036.  
  2037. SDPolyline class
  2038.     instanceVariableNames: ''
  2039.  
  2040. "
  2041.     The following instance variables are inherited by this class: 
  2042.         SDGraphicObject class -
  2043.         Object class -
  2044.         Class -- name, classPool, sharedPools
  2045.         ClassDescription -- instanceVariables, organization
  2046.         Behavior -- superclass, methodDict, format, subclasses
  2047.         Object -- 
  2048. "!
  2049.  
  2050.  
  2051. !SDPolyline class methodsFor: 'instance creation'!
  2052.  
  2053. vertices: aCollectionOfPoints
  2054.         ^self new vertices: aCollectionOfPoints! !
  2055.  
  2056. SDPolyline subclass: #SDPolygon
  2057.     instanceVariableNames: ''
  2058.     classVariableNames: ''
  2059.     poolDictionaries: ''
  2060.     category: 'SmallDraw'
  2061.  
  2062. "
  2063.     The following instance variables are inherited by this class: 
  2064.         SDPolyline -- vertices
  2065.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  2066.         Object -- 
  2067. "!
  2068.  
  2069.  
  2070. !SDPolygon methodsFor: 'private'!
  2071.  
  2072. vertices: aCollectionOfPoints
  2073.         "This just makes sure that the receiver's vertices are closed."
  2074.         super vertices: (aCollectionOfPoints first = aCollectionOfPoints last
  2075.                 ifTrue: [aCollectionOfPoints]
  2076.                 ifFalse: [aCollectionOfPoints
  2077.                 asOrderedCollection add: aCollectionOfPoints first; yourself]) asArray! !
  2078.  
  2079. SDPolygon subclass: #SDQuadrangle
  2080.     instanceVariableNames: ''
  2081.     classVariableNames: ''
  2082.     poolDictionaries: ''
  2083.     category: 'SmallDraw'
  2084.  
  2085. "
  2086.     The following instance variables are inherited by this class: 
  2087.         SDPolygon -
  2088.         SDPolyline -- vertices
  2089.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  2090.         Object -- 
  2091. "!
  2092.  
  2093.  
  2094. !SDQuadrangle methodsFor: 'accessing'!
  2095.  
  2096. origin: aPoint corner: anotherPoint
  2097.         self vertex: aPoint vertex: anotherPoint!
  2098.  
  2099. vertex: aPoint vertex: anotherPoint
  2100.         "Don't allow zero-size."
  2101.         | r |
  2102.         r := (Rectangle vertex: aPoint vertex: (aPoint = anotherPoint
  2103.                         ifTrue: [aPoint + 1]
  2104.                         ifFalse: [anotherPoint])) rounded.
  2105.         self vertices: (Array
  2106.                     with: r topLeft
  2107.                     with: r topRight
  2108.                     with: r bottomRight
  2109.                     with: r bottomLeft)! !
  2110.  
  2111. !SDQuadrangle methodsFor: 'displaying'!
  2112.  
  2113. joinStyle
  2114.         "Answer the appropriate join style for displaying the receiver."
  2115.         ^GraphicsContext joinMiter! !
  2116.  
  2117. !SDQuadrangle methodsFor: 'manipulation'!
  2118.  
  2119. scaleAbsoluteBy: aPercentagePoint aboutHandleAt: anIndex
  2120.         | anchor |
  2121.         anchor := self handles at: anIndex.
  2122.         self  vertex: anchor
  2123.         vertex: anchor + (aPercentagePoint * (anchor dist: (self handleOpposite: anchor)))! !
  2124.  
  2125. !SDQuadrangle methodsFor: 'testing'!
  2126.  
  2127. interiorContainsPoint: aPoint
  2128.         "This is valid as long as SDQuadrangles are aligned with the x-y axis."
  2129.         ^self boundingBox containsPoint: aPoint! !
  2130. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2131.  
  2132. SDQuadrangle class
  2133.     instanceVariableNames: ''
  2134.  
  2135. "
  2136.     The following instance variables are inherited by this class: 
  2137.         SDPolygon class -
  2138.         SDPolyline class -
  2139.         SDGraphicObject class -
  2140.         Object class -
  2141.         Class -- name, classPool, sharedPools
  2142.         ClassDescription -- instanceVariables, organization
  2143.         Behavior -- superclass, methodDict, format, subclasses
  2144.         Object -- 
  2145. "!
  2146.  
  2147.  
  2148. !SDQuadrangle class methodsFor: 'instance creation'!
  2149.  
  2150. origin: aPoint corner: anotherPoint
  2151.         ^self new origin: aPoint corner: anotherPoint! !
  2152.  
  2153. SDQuadrangle subclass: #SDEllipse
  2154.     instanceVariableNames: ''
  2155.     classVariableNames: 'UnitCircle '
  2156.     poolDictionaries: ''
  2157.     category: 'SmallDraw'
  2158.  
  2159. "
  2160.     The following instance variables are inherited by this class: 
  2161.         SDQuadrangle -
  2162.         SDPolygon -
  2163.         SDPolyline -- vertices
  2164.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  2165.         Object -- 
  2166. "!
  2167.  
  2168.  
  2169. !SDEllipse methodsFor: 'accessing'!
  2170.  
  2171. xRadius
  2172.         ^self width / 2!
  2173.  
  2174. yRadius
  2175.         ^self height / 2! !
  2176.  
  2177. !SDEllipse methodsFor: 'converting'!
  2178.  
  2179. outline
  2180.         "Answer an array of points that represent the receiver as an outline."
  2181.         ^UnitCircle collect: [:pt | self center + (pt * (self xRadius@self  yRadius))]! !
  2182.  
  2183. !SDEllipse methodsFor: 'displaying'!
  2184.  
  2185. displayOn: aGC scale: aScalePoint
  2186.         | bb |
  2187.         bb := self boundingBox scaledBy: aScalePoint.
  2188.         self insideColor isNil
  2189.                 ifFalse: [aGC
  2190.                                         paint: self insideColor;
  2191.                                         displayWedgeBoundedBy: bb startAngle: 0 
  2192.  
  2193. sweepAngle: 360 at: 0@0].
  2194.         self borderColor isNil
  2195.                 ifFalse: [aGC
  2196.                                         lineWidth: self lineWidth;
  2197.                                         paint: self borderColor.
  2198.                                 self isSquished
  2199.                                         ifTrue: [aGC displayLineFrom: bb origin to: bb corner]
  2200.                                         ifFalse: [aGC
  2201.                             displayArcBoundedBy: bb 
  2202.                             startAngle: 0
  2203.                             sweepAngle: 360
  2204.                             at:0@0]]! !
  2205.  
  2206. !SDEllipse methodsFor: 'testing'!
  2207.  
  2208. edgeContainsPoint: aPoint
  2209.         ^self isCircle
  2210.                 ifTrue: [(self center dist: aPoint) <= (self xRadius + self  tolerance)]
  2211.                 ifFalse: [| offset constantLength |
  2212. "Determine focus points on major axis."
  2213.                                 self width >= self height
  2214.                                         ifTrue: [offset := (self xRadius  squared - self yRadius squared) sqrt@0.
  2215.                                                         constantLength := self  width]
  2216.                                         ifFalse: [offset := 0@(self yRadius  squared - self xRadius squared) sqrt.
  2217.                                                         constantLength := self  height].
  2218. "Now, answer whether the sum of the distances between aPoint and the two focus  
  2219. points is close enough to the constantLength."
  2220.                                 ((((self center - offset) dist: aPoint) +  
  2221.                     ((self center + offset) dist: aPoint)) -
  2222.                     constantLength)
  2223.                 abs < self tolerance]!
  2224.  
  2225. interiorContainsPoint: aPoint
  2226.         ^self isCircle
  2227.                 ifTrue: [(self center dist: aPoint) <= self xRadius]
  2228.                 ifFalse: [| offset constantLength |
  2229. "Determine focus points on major axis."
  2230.                                 self width >= self height
  2231.                                         ifTrue: [offset := (self xRadius  squared - self yRadius squared) sqrt@0.
  2232.                                                         constantLength := self  width]
  2233.                                         ifFalse: [offset := 0@(self yRadius  squared - self xRadius squared) sqrt.
  2234.                                                         constantLength := self  height].
  2235. "Now, answer whether the sum of the distances between aPoint and the two focus  
  2236. points is less than the constantLength."
  2237.                                 (((self center - offset) dist: aPoint) +
  2238.                   ((self center + offset) dist: aPoint)) <= constantLength]!
  2239.  
  2240. isCircle
  2241.         ^self width = self height! !
  2242. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2243.  
  2244. SDEllipse class
  2245.     instanceVariableNames: ''
  2246.  
  2247. "
  2248.     The following instance variables are inherited by this class: 
  2249.         SDQuadrangle class -
  2250.         SDPolygon class -
  2251.         SDPolyline class -
  2252.         SDGraphicObject class -
  2253.         Object class -
  2254.         Class -- name, classPool, sharedPools
  2255.         ClassDescription -- instanceVariables, organization
  2256.         Behavior -- superclass, methodDict, format, subclasses
  2257.         Object -- 
  2258. "!
  2259.  
  2260.  
  2261. !SDEllipse class methodsFor: 'initialize'!
  2262.  
  2263. initialize
  2264.         "Construct an array of points that describe a unit circle."
  2265.         UnitCircle := OrderedCollection new: 37.
  2266.         0 to: 2*Float pi by: Float pi / 18 do: [:a | UnitCircle add: (a cos @ a sin)].
  2267.         UnitCircle addLast: UnitCircle first.
  2268.         UnitCircle := UnitCircle asArray! !
  2269.  
  2270. SDGraphicObject subclass: #SDGraphicGroup
  2271.     instanceVariableNames: 'elements '
  2272.     classVariableNames: ''
  2273.     poolDictionaries: ''
  2274.     category: 'SmallDraw'
  2275.  
  2276. "
  2277.     The following instance variables are inherited by this class: 
  2278.         SDGraphicObject -- insideColor, borderColor, lineWidth, handles, boundingBox
  2279.         Object -- 
  2280. "!
  2281.  
  2282.  
  2283. !SDGraphicGroup methodsFor: 'accessing'!
  2284.  
  2285. borderColor: aColorValue
  2286.         self elements do: [:o | o borderColor: aColorValue]!
  2287.  
  2288. elements
  2289.         ^elements!
  2290.  
  2291. elements: aCollectionOfGraphicObjects
  2292.         elements := aCollectionOfGraphicObjects.
  2293.         self computeBoundingBox!
  2294.  
  2295. insideColor: aColorValue
  2296.         self elements do: [:o | o insideColor: aColorValue]!
  2297.  
  2298. lineWidth: anInteger
  2299.         self elements do: [:o | o lineWidth: anInteger]! !
  2300.  
  2301. !SDGraphicGroup methodsFor: 'displaying'!
  2302.  
  2303. displayOn: aGC scale: aScalePoint
  2304.         self elements do: [:o | o displayOn: aGC scale: aScalePoint]! !
  2305.  
  2306. !SDGraphicGroup methodsFor: 'manipulation'!
  2307.  
  2308. scaleAbsoluteBy: aPercentagePoint aboutHandleAt: anIndex
  2309.         "aPercentagePoint = (unitVector) * (newDiagonalDistance /  oldDiagonalDistance)"
  2310.  
  2311.         | anchor corner difference anchorHandle oldHandle newPoint unitVector  
  2312. scale uv length newLength len perc delta |
  2313.         anchor := self handles at: anIndex.
  2314.         corner := anchor + (aPercentagePoint * (anchor dist: (self  handleOpposite: anchor))).
  2315.         difference := corner - (self handleOpposite: anchor).
  2316.     uv := (anchor - (self handleOpposite: anchor)) unitVector.
  2317.     length := anchor dist: (self handleOpposite: anchor).
  2318.     newLength := length + (difference * uv).
  2319.  
  2320.         self elements do: [:eachObject |
  2321.                 anchorHandle := eachObject handles at: anIndex.
  2322.                 oldHandle := eachObject handleOpposite: anchorHandle.
  2323.                 newPoint := oldHandle + difference.
  2324.                 unitVector := (newPoint - anchorHandle) unitVector.
  2325.                 scale := (newPoint dist: anchorHandle) / (oldHandle dist:  anchorHandle).
  2326.  
  2327.     len := anchorHandle dist: anchor.
  2328.     perc := len / length.
  2329.     delta := (perc * newLength) + anchorHandle.
  2330.  
  2331.                 eachObject
  2332.                         translateBy: delta;
  2333.                         scaleAbsoluteBy: (unitVector * scale) aboutHandleAt:  anIndex].
  2334.         self computeBoundingBox!
  2335.  
  2336. scaleRelativeBy: aPercentagePoint aboutHandleAt: anIndex
  2337.         "When a group is stretched, each member of the group must maintain its  
  2338.     relative position within the group. This is different than stretching  
  2339.     individual objects whose handle at anIndex remains stationary."
  2340.         | origin corner groupDiagonal  newDiagonal objectDiagonal |
  2341.         origin := self handles at: anIndex.
  2342.         corner := self handleOpposite: origin.
  2343.         groupDiagonal := corner - origin.
  2344.         newDiagonal := groupDiagonal * aPercentagePoint.
  2345.  
  2346.         self elements do: [:eachObject |
  2347.                 objectDiagonal := (eachObject handles at: anIndex) - origin.
  2348.                 eachObject
  2349.                         translateBy: (newDiagonal * objectDiagonal /  groupDiagonal) - objectDiagonal;
  2350.                         scaleRelativeBy: aPercentagePoint aboutHandleAt:  anIndex].
  2351.         self computeBoundingBox!
  2352.  
  2353. translateBy: aPoint
  2354.         self elements do: [:o | o translateBy: aPoint].
  2355.         self computeBoundingBox! !
  2356.  
  2357. !SDGraphicGroup methodsFor: 'private'!
  2358.  
  2359. computeBoundingBox
  2360.         self setBoundingBox:
  2361.                 (self elements inject: self elements first boundingBox into:
  2362.                         [:bb :o | bb merge: o boundingBox])! !
  2363.  
  2364. !SDGraphicGroup methodsFor: 'testing'!
  2365.  
  2366. containsPoint: aPoint
  2367.         ^(self elements detect: [:eachObject | eachObject containsPoint:  aPoint]
  2368.                  ifNone: [nil]) notNil! !
  2369.  
  2370. !SDGraphicGroup methodsFor: 'copying'!
  2371.  
  2372. deepCopy
  2373.     "Answer a copy of self with copies of instance variables I define.
  2374.     Subclasses that define additional instance variables may want to override me."
  2375.  
  2376.     ^super copy
  2377.         elements: (self elements collect: [ :e | e copy ]);
  2378.         yourself.! !
  2379. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  2380.  
  2381. SDGraphicGroup class
  2382.     instanceVariableNames: ''
  2383.  
  2384. "
  2385.     The following instance variables are inherited by this class: 
  2386.         SDGraphicObject class -
  2387.         Object class -
  2388.         Class -- name, classPool, sharedPools
  2389.         ClassDescription -- instanceVariables, organization
  2390.         Behavior -- superclass, methodDict, format, subclasses
  2391.         Object -- 
  2392. "!
  2393.  
  2394.  
  2395. !SDGraphicGroup class methodsFor: 'instance creation'!
  2396.  
  2397. with: aCollectionOfGraphicObjects
  2398.         ^self new elements: aCollectionOfGraphicObjects! !
  2399.  
  2400.  
  2401. !Point methodsFor: 'SmallDraw additions'!
  2402.  
  2403. quadrantContaining: aPoint
  2404.         "Answer the number of the quadrant containing aPoint placing the  
  2405.     receiver at the origin, where the quadrants are numbered as follows:
  2406.                 1  |  0
  2407.                 ------
  2408.                 2  |  3
  2409.         This convention is used for determining whether a point is in a polygon."
  2410.         ^aPoint x > x
  2411.                 ifTrue: [aPoint y >= y
  2412.                                         ifTrue: [3]     
  2413.                                         ifFalse: [0]]
  2414.                 ifFalse: [aPoint y >= y
  2415.                                         ifTrue: [2]     
  2416.                                         ifFalse: [1]]! !
  2417.  
  2418. SmallDrawView initialize!
  2419.  
  2420. SDEllipse initialize!
  2421.  
  2422.  
  2423.